expertcad/SRC/Main/18_09_2015/U_Common.pas
2025-05-12 10:07:51 +03:00

31604 lines
1.1 MiB

//{$A+,B-,C+,D+,E-,F-,G+,H+,I-,J-,K-,L+,M-,N+,O-,P+,Q-,R-,S-,T-,U+,V+,W-,X+,Y+,Z1}
//{$MINSTACKSIZE $00004000}
//{$MAXSTACKSIZE $00100000}
//{$IMAGEBASE $00400000}
//{$APPTYPE GUI}
//{$J+}
unit U_Common;
interface
uses
Windows, Forms, StdCtrls, Classes, ComCtrls, Controls, DrawEngine, PCTypesUtils, SysUtils, Dialogs,
Contnrs, DrawObjects, PCDrawBox, PCDrawing, PowerCad, Graphics, U_Cad, U_ESCadClasess, U_SCSLists, U_SCSComponent,
ActnList, U_SCSEngineTest, U_BaseCommon, U_Progress, U_Splash, Math, U_Navigator, Messages, LibJpeg, ClipBrd, ExtCtrls, U_HouseClasses;
const
// Polly Line Type
pltNone = 0;
pltConvex = 1; // Âûïóêëûé
pltConcave = 2; // Âîãíóòûé
cnstPi180 = pi / 180;
type
TListFormatType = record
PageLayout: TPageLayout;
PageOrient: TPageOrient;
PageWidth: Double;
PageHeight: Double;
StampLang: TStampLang;
StampType: TStampType;
ShowMainStamp: Boolean;
ShowUpperStamp: Boolean;
ShowSideStamp: Boolean;
ListCountX: Integer;
ListCountY: Integer;
{CADStampMargins: TDoubleRect;
CADStampDeveloper: string[255]; //15.11.2011 - ðàçðàáîòàë
CADStampChecker: string[255]; //15.11.2011 - ïðîâåðèë
CADStampMainEngineer: string[255]; //02.10.2012 - Ãëàâíûé èíæåíåð ïðîåêòà
CADStampApproved: string[255]; //02.10.2012 - Óòâåðäèë
CADStampDesignStage: string[255]; //02.10.2012 - Ñòàäèÿ ïðîåêòèð.}
StampFields: TListStampFields;
end;
type
// íàñòðîéêè ëèñòà, äëÿ ñðàâíåíèÿ ñ ïðèìåíåííûìè íàñòðîéêàìè
TCADParams = record
// Âêëàäêà "Îáùèå"
CADHeightRoom: Double; // äëÿ ïîòîëêà
CADHeightFalseFloor: Double; // äëÿ ôàëüø ïîòîëêà
CADHeightConns: Double; // äëÿ êîííåêòîðîâ
CADHeightLines: Double; // äëÿ òðàññ
CADIndexPointObjects: Integer; // èíäåêñ äëÿ íîâûõ ÐÒ
CADIndexConnector: Integer; // èíäåêñ äëÿ íîâûõ êîííåêòîðîâ
CADIndexLine: Integer; // èíäåêñ äëÿ íîâûõ òðàññ
// Âêëàäêà "CAD"
CADPageSizeIndex: Integer; // èíäåêñ ðàçìåðà ëèñòà À4
CADPageOrient: TPageOrient; // îðèåíòàöèÿ ëèñòà
CADStampType: TStampType; // øòàìï ëèñòà
CADStampLang: TStampLang; // ÿçûê ðàìêè
CADStampMargins: TDoubleRect; // îòñòóïû ðàìêè ëèñòà //11.11.2011
CADWidth: Double; // øèðèíà ÊÀÄ
CADHeight: Double; // âûñîòà ÊÀÄ
CADListCountX: Double; // êîë-âî ëèñòîâ äàííîãî ôîðìàòà ïî ãîðèçîíòàëè
CADListCountY: Double; // êîë-âî ëèñòîâ äàííîãî ôîðìàòà ïî âåðòèêàëè
CADFontName: string[255]; // øðèôò ÊÀÄà
CADGridStep: Double; // øàã ñåòêè
CADMapScale: Double; // íàñòðîéêà ëèíåéêè
CADTraceColor: TColor; // öâåò òðàññû
CADTraceStyle: TPenStyle; // ñòèëü òðàññû
CADTraceWidth: Integer; // øèðèíà òðàññû
CADBlockStep: Double; // øàã áëîêà
CADObjectCaptions: TShowType; // âèä ïîäïèñè ê îáúåêòàì
CADLinesCaptions: TShowKind; // âèä ïîäïèñåé ê ëèíèÿì
CADObjectNotes: TShowType; // âèä âûíîñîê ê îáúåêòàì
CADLinesNotes: TShowKind; // âèä âûíîñîê ê ëèíèÿì
CADNotePrefix: string[1]; // ïðåôèêñ îòîáðàæåíèÿ
CADShowLineObjectCaption: Boolean; // Îòîáðàæàòü ïîäïèñè ê ëèíåéíûì îáúåêòàì
CADShowLineObjectLength: Boolean; // Îòîáðàæàòü äëèíó ëèíåéíûõ îáúåêòîâ
CADShowLineObjectNote: Boolean; // Îòîáðàæàòü âûíîñêè ê ëèíåéíûì îáúåêòàì
CADShowConnObjectCaption: Boolean; // Îòîáðàæàòü ïîäïèñè ê òî÷å÷íûì îáúåêòàì
CADShowConnObjectNote: Boolean; // Îòîáðàæàòü âûíîñêè ê òî÷å÷íûì îáúåêòàì
CADShowRaise: Boolean; // îòîáðàæàòü ñèìâîëû ñ-ï
CADPutCableInTrace: Boolean; // Ëîæèòü êàáåëü íà òðàññó
CADLinesCaptionsColor: Integer; // öâåò ïîäïèñåé òðàññ
CADConnectorsCaptionsColor: Integer; // öâåò ïîäïèñåé êîííåêòîðîâ
CADLinesNotesColor: Integer; // öâåò âûíîñîê òðàññ
CADConnectorsNotesColor: Integer; // öâåò âûíîñîê êîííåêòîðîâ
CADLinesCaptionsFontSize: Integer; // ðàçìåð øðèôòà ïîäïèñåé òðàññ
CADConnectorsCaptionsFontSize: Integer; // ðàçìåð øðèôòà ïîäïèñåé êîííåêòîðîâ
CADLinesNotesFontSize: Integer; // ðàçìåð øðèôòà âûíîñîê òðàññ
CADConnectorsNotesFontSize: Integer; // ðàçìåð øðèôòà âûíîñîê êîííåêòîðîâ
CADLinesCaptionsFontBold: Boolean; // æèðíûé øðèôò ïîäïèñåé òðàññ
CADCrossATSFontSize: Integer; // ðàçìåð øðèôòà äëÿ Êðîññ ÀÒÑ
CADDistribCabFontSize: Integer; // ðàçìåð øðèôòà äëÿ ÐØ
CADCrossATSFontBold: Boolean; // æèðíûé øðèôò äëÿ Êðîññ ÀÒÑ
CADDistribCabFontBold: Boolean; // æèðíûé øðèôò äëÿ ÐØ
CADPrintType: TPrintType; // òèï ïå÷àòè
SCSType: TSCSType; // òèï ëèñòà ÑÊÑ
CADTraceStepRotate: Integer; // øàã óãëà ïîâîðîòà òðàññû
AutoCadMouse: Boolean; // ìûøü Àâòîêàä
ScaleByCursor: Boolean; // ìàñøòàáèðîâàòü ïî ïîëîæåíèþ êóðñîðà
AutoPosTraceBetweenRM: Boolean; // òðàññó ìåæäó äâóìÿ ÐÌ ðàçìåùàòü íà âûñîòå ýòèõ ÐÌ...
CADShowMainStamp: Boolean; // ïîêàçûâàòü îñíîâíîé øòàìï íà ðàìêå ëèñòà
CADShowUpperStamp: Boolean; // ïîêàçûâàòü âåðõíèé øòàìï íà ðàìêå ëèñòà
CADShowSideStamp: Boolean; // ïîêàçûâàòü áîêîâîé øòàìï íà ðàìêå ëèñòà
CADSaveUndoCount: Integer; // êîë-âî äåéñòâèé ïîñëå êîòîðîãî ñëåäóåò äåëàòü ñëåïîê
CADAllowSupplieskind: Boolean; // ó÷èòûâàòü âèä ïîñòàâêè ïðè ïðîêëàäêè ÊÊ
CADNewTraceLengthType: Byte;
CADShowRaiseDrawFigure: Boolean;
end;
PCADParams = ^TCADParams;
// Äëÿ ñõåìû ïðîåêòà
// Çäàíèå - ïðîåêò
TPlanProject = record
FSizeX: Double;
FSizeY: Double;
FBounds: TDoubleRect;
FFloors: TList;
end;
PPlanProject = ^TPlanProject;
// Ýòàæ â çäàíèè
TPlanFloor = record
FSizeX: Double;
FSizeY: Double;
FBounds: TDoubleRect;
FCabinets: TList;
end;
PPlanFloor = ^TPlanFloor;
// Êàáèíåò â ýòàæå
TPlanCabinet = record
FSizeX: Double;
FSizeY: Double;
FBounds: TDoubleRect;
FObjects: TList;
end;
PPlanCabinet = ^TPlanCabinet;
TNormColumn = record
IDNormStruct: Integer;
FCableName: string[255];
FColumns: TStringList;
end;
PNormColumn = ^TNormColumn;
TNormStruct = record
ID: Integer;
FNumber: string[10];
FName: string[255];
FIzm: string[20];
FCount: string[50];
FNormColumns: TList;
end;
PNormStruct = ^TNormStruct;
// òèï îáúåêòà äëÿ îòîáðàæåíèÿ ãðóïïîâûõ ñâîéñòâ
TObjectsTypeProp = (otp_Single, otp_ConnObjects, otp_ConnConnectors, otp_ConnRaises, otp_LineTraces, otp_LineRaises);
TAngleType = (at_Horizontal, at_Vertical);
// ïîëó÷èòü ëèñò ïî åãî ID
function GetListByID(AID_List: Integer): TF_CAD;
// **** ïðèâÿçêè îáúåêòîâ ****
// êîííåêòîð ê òðàññå
procedure SnapConnectorToOrtholine(AConnector: TConnectorObject; ASnapLine: TOrtholine);
// îáúåêò ê òðàññå
procedure SnapPointObjectToOrthoLine(APointObject: TConnectorObject; ASnapLine: TOrthoLine);
// êîííåêòîð ê êîííåêòîðó
procedure SnapConnectorToConnector(AConnector, ASnapConnector: TConnectorObject; AOnRaise: Boolean = false);
// êîííåêòîð ê îáúåêòó
procedure SnapConnectorToPointObject(AConnector, APointObject: TConnectorObject; AOnRaise: Boolean = false; ASnapObjectToLine: Boolean = false);
// îáúåêò ê êîííåêòîðó
procedure SnapPointObjectToConnector(APointObject, AConnector: TConnectorObject; AOnRaise: Boolean = false);
// êîííåêòîð ê Äîìó
procedure SnapConnectorToHouse(aConnector: TConnectorObject; aSnapHouse: THouse);
// êîííåêòîð ê âåðòèêàëüíîé òðàññå
procedure SnapConnectorToVertical(AConnector: TConnectorObject; ASnapLine: TOrtholine);
// îáúåêò ê âåðòèêàëüíîé òðàññå
procedure SnapPointObjectToVertical(APointObject: TConnectorObject; ASnapLine: TOrthoLine);
// **** âûïîëíèòü ïðèâÿçêó ïî îïðåäåëåííîìó çàêîíó ****
// êîííåêòîð ê òðàññå
procedure CheckingSnapConnectorToOrtholine(AConnector: TConnectorObject; ASnapLine: TOrtholine);
// îáúåêò ê òðàññå
procedure CheckingSnapPointObjectToOrthoLine(APointObject: TConnectorObject; ASnapLine: TOrthoLine);
// êîííåêòîð ê êîííåêòîðó
procedure CheckingSnapConnectorToConnector(AConnector, ASnapConnector: TConnectorObject);
// êîííåêòîð ê îáúåêòó
procedure CheckingSnapConnectorToPointObject(AConnector, APointObject: TConnectorObject; aUseBaseConnector: Boolean);
// îáúåêò ê êîííåêòîðó
procedure CheckingSnapPointObjectToConnector(APointObject, AConnector: TConnectorObject);
// c-ï
// ñîçäàòü ...
// íà îáúåêòå
Procedure CreateRaiseOnPointObject(APointObject: TConnectorObject; AHeight: Double; aBaseConnector: TConnectorObject = nil);
// íà êîííåêòîðå
Procedure CreateRaiseOnConnector(AConnector: TConnectorObject; AHeight: Double);
// íà ñâÿçóþùåì êîííåêòîðå/îáúåêòå îò òðàññû
Procedure CreateRaiseOnNextObject(AConnector: TConnectorObject; AJoinedLine: TOrthoLine; AHeight: Double);
// ïåðåñîåäèíåíèå êîìïîíåíò ÷åðåç ñ-ï
Procedure AutoConnectOverRaiseInCAD(AObjFromRaise, ARaiseObj: TConnectorObject);
// èçìåíèòü ïîëîæåíèå ...
// íà îáúåêòå
Procedure ChangeRaiseOnPointObject(APointObject: TConnectorObject; AHeight: Double);
// íà êîííåêòîðå
Procedure ChangeRaiseOnConnector(AConnector: TConnectorObject; AHeight: Double);
// íà ñâÿçóþùåì êîííåêòîðå/îáúåêòå îò òðàññû
Procedure ChangeRaiseOnNextObject(AConnector: TConnectorObject; AJoinedLine: TOrthoLine; AHeight: Double);
// óäàëèòü ...
// ñ îáúåêòà
Procedure DestroyRaiseOnPointObject(APointObject: TConnectorObject);
// ñ êîííåêòîðà
Procedure DestroyRaiseOnConnector(AConnector: TConnectorObject);
// ïîäíÿòü ëèíèþ íà âûñîòó
Procedure RaiseLineOnHeight(ALine: TOrthoLine; AHeight: Double; ATracesList: TList);
// íóæíî ëè ñîçäàâàòü ñ-ï ïðè ïîäúåìå òðàññû
Function CheckNeedCreateRaiseOnRaiseTrace(ALine: TOrthoLine; AJoinedConn: TConnectorObject; ATracesList: TList): Boolean;
// c-ï ìåæýòàæíûå ...
// ñîçäàòü ì-ý ñ-ï íà îáúåêòå
Function CreateBetweenFloorRaiseOnPointObject(APointObject: TConnectorObject; ARaiseType: TLineRaiseType): TConnectorObject;
// ñîçäàòü ì-ý ñ-ï íà êîííåêòîðå
Function CreateBetweenFloorRaiseOnConnector(AConnector: TConnectorObject; ARaiseType: TLineRaiseType): TConnectorObject;
// c-ï ìàãèñòðàëüíûå ...
// ñîçäàòü ìàãèñòðàëüíûé ñ-ï íà îáúåêòå
Function CreateTrunkRaiseOnPointObject(APointObject: TConnectorObject; ARaiseType: TLineRaiseType; aTrunkLength: Double): TConnectorObject;
// ñîçäàòü ìàãèñòðàëüíûé ñ-ï íà êîííåêòîðå
Function CreateTrunkRaiseOnConnector(AConnector: TConnectorObject; ARaiseType: TLineRaiseType; aTrunkLength: Double): TConnectorObject;
// îòâÿçàòü êîííåêòîð îò îáúåêòà
procedure UnsnapConnectorFromPointObject(AConnector, APointObject: TConnectorObject; AOnRaise: Boolean = false);
// îïðåäåëåòü òî÷êó ïðèâÿçêè êîííåêòîðà ê îáúåêòó ïðè îäèíàêîâîé âûñîòå (êðàñíàÿ òî÷êà)
function GetCrossPoint(X1_Line, Y1_Line, X2_Line, Y2_Line, X1_Object, Y1_Object, X2_Object, Y2_Object: Double): TDoublePoint;
// ïîëó÷èòü ÓÃÎ ñ ÍÁ äëÿ îáúåêòà
function GetConnectorImg(aOT: TConnectorType): TFigureGrpMod;
// ïîëó÷èòü ÓÃÎ ñ ÍÁ äëÿ òðàññû
function GetOrthoLineImg(aOT: TOrthoLineType): TFigureGrpMod;
// ïàðàìåòðû ïî äåôîëòó äëÿ ëèñòà ÊÀÄà (òîëüêî ÊÀÄîâñêèå íàñòðîéêè)
Procedure SetDefaultPageParams;
// âåðíóòü ïàðàìåòðû äëÿ ëèñòà ÊÀÄà (òîëüêî ÊÀÄîâñêèå íàñòðîéêè) ïîñëå ïåðåàêâòèâàöèè îêîí ÊÀÄà
Procedure ReturnListParams;
// Ïðèíÿòèå êîìïîíåíòà èç íîðìàòèâíîé áàçû
Function GetComponentFromNormBase(X, Y: Double; NB_Component: TSCSComponent; ASnapFigure: TFigure; CompStateType: TCompStateType): TFigure;
// àâòîïîèñê îáúåêòà ïðè DragOver
Function FindAutoSnapObject(X, Y: Double; NB_Component: TSCSComponent): TFigure;
// Âçàèìîäåéñòâèå Ìåíåäæåðà ïðîåêòîâ è CAD`à ...
// Íîâîå èìÿ äëÿ îáúåêòà
Procedure SetNewObjectNameInCad(AID_List, AID_Figure: Integer; AOldObjName, ANewObjName: String);
// óäàëèòü îáúåêò ñ ÊÀÄà
Procedure DeleteObjectFromCad(AID_List, AID_Figure: Integer; AObjName: String);
// óäàëèòü îáúåêò ñ SCSFigureGrp
Procedure DeleteObjectFromSCSFigureGrp(ASCSFigureGrp: TSCSFigureGrp; AObjects: TFigure);
// âûäåëèòü îáúåêò íà ÊÀÄå
Procedure SelectObjectInCAD(AID_List, AID_Figure: Integer; AObjName: String);
// Ïåðåìåùàåò îáúåê â êîíåö ñïèñêà - íóæíî ÷òîáû îí èìåë âûñøèé ïðèîðèòåò äëÿ âûäåëåíèÿ
procedure FigureBringToFront(AFigure: TFigure); //29.09.2010 //#From Oleg#
procedure FigureSendToBack(AFigure: TFigure); //19.08.2011 //#From Oleg#
// Ïåðåìåùàåò êîííåêòîð áåç ÓÃÎ â êîíåö ñïèñêà - íóæíî ÷òîáû îí èìåë âûñøèé ïðèîðèòåò äëÿ âûäåëåíèÿ
procedure SetConnObjectSelectHightPriority(AFigure: TConnectorObject); //29.09.2010 //#From Oleg#
// Âçàèìîäåéñòâèå Ëèñòîâ â ÌÏ è íà CAD-å ...
// ïåðåêëþ÷èòü ëèñò
Procedure SwitchListInCAD(AID_List: Integer; const ListName: String);
// ïåðåèìåíîâàòü ëèñò
Procedure RenameListInCAD(AID_List: Integer; const OldListName, NewListName: String; AOldListParams: PListParams; ARenameOnFrame: Boolean=true);
// óäàëèòü ëèñò
Procedure DeleteListInCAD(AID_List: Integer; ListName: String);
// ïîëó÷èòü ëèñòû èíòåðôåéñîâ
Procedure FindConnectionsInterfaces(AConnector1, AConnector2: TConnectorObject);
// àâòîñîåäèíåíèå ïî èíòåðôåéñàì ïðè äîáàâëåíèè êàáåëÿ íà òðàññó
Procedure AutoConnectOnAppendCable(AID_List, AID_Line: Integer);
// àâòîñîåäèíåíèå ïî èíòåðôåéñàì ïðè äîáàâëåíèè îáúåêòà íà òðàññó
Procedure AutoConnectObjectInTrace(APointObject: TConnectorObject; ATrace1, ATrace2: TOrthoLine);
// àâòîñîåäèíåíèå ïî èíòåðôåéñàì ïðè ñîåäèíåíèè êîííåêòîðà/îáúåêòà ê êîííåêòîðó ñ òðàññàìè
procedure AutoConnectObjectToConnectors(APointObject, AConnectedConn: TConnectorObject; AConnectorsList: TList);
// äîáàâëåíèå/óäàëåíèè êîìïëåêòóþùèõ â îáúåêòû ...
// äîáàâëåíèå â òðàññó
Procedure AppendLineInterfacesToCAD(AID_List, AID_Figure: Integer; AObjName: string; aDivValue: Double);
// óäàëåíèå èç òðàññû
Procedure RemoveLineInterfacesFromCAD(AID_List, AID_Figure: Integer; AObjName: string);
// äîáàâëåíèå â îáúåêò
Procedure AppendNoLineInterfacesToCAD(AID_List, AID_Figure: Integer; AObjName: string);
// óäàëåíèå èç îáúåêòà
Procedure RemoveNoLineInterfacesFromCAD(AID_List, AID_Figure: Integer; AObjName: string);
// âûäåëèòü âñþ òðàññó îò òî÷êè äî òî÷êè
function SelectTraceInCAD(LinesList: TList): Double;
// óáðàòü âûäåëåíèå ýòîé òðàññû îò òî÷êè äî òî÷êè
function DeselectTraceInCAD: Boolean;
// óãîë ëèíèè
function GetLineAngle(AP1, AP2: TDoublePoint): Double;
// âûðîâíÿòü ëèíèþ ïî ñåòêå
Procedure ReAlignLine(aAlignedLine: TOrthoLine);
// âûðîâíÿòü òî÷. îáúåêò ïî ñåòêå
Procedure ReAlignObject(aAlignedObject: TConnectorObject);
// ïðîöåäóðà íàõîæäåíèÿ òðàññû íà CAD-å
function GetAllTraceInCAD(AFigureServer, AFigureWS: TFigure): TList;
// ïðîöåäóðà íàõîæäåíèÿ ãðóïïû ïóòåé ïî îòìå÷åííûì òðàññàì
function GetAllTraceInCADByMarked(aAFigureServer, aAFigureWS: TFigure; SotrListByMarked: Boolean = True): TList;
//Tolik
function GetAllTraceInCADByMarked_New1(aAFigureServer, aAFigureWS: TFigure): TList;
//
function CheckConnJoinBetwFloor(aConn: TConnectorObject; CheckRaiseUpDown: boolean = False): Boolean;
function CheckOtherTraceBetwFloor(Trace: TOrthoLine; CheckRaiseUpDown: boolean = False; CheckMore: boolean = false): Boolean;
function GetAllNoConnectedTraces(aCAD: TF_CAD): TList;
// ïðîâåðêà íà íàëè÷èå îáúåêòà â òåêóùåì ëèñòå
function CheckNoFigureInList(ACheckFigure: TFigure; AList: TList): Boolean;
// ïðîâåðêà íà íàëè÷èå ÊÀÄ ëèñòà â òåêóùåì ëèñòå
function CheckNoCadInList(ACheckCad: TF_CAD; AList: TList): Boolean;
// ïðîâåðêà íà íàëè÷èå ëèñòà â ëèñòå
function CheckNoListInList(AInList, AList: TList): Boolean;
// âûäåëèòü ïîäñîåäèíåííûå êîííåêòîðû
Procedure SelectConnectedConnector(AID_List, AID_Figure: Integer);
// âûäåëèòü ïîäñîåäèíåííûå êàáåëè
Procedure SelectConnectedCables(AID_List: Integer; ALinesList: TIntList);
// Ïîäúåìû ...
function GetBasisPointByObjFromRaise(aObj: TConnectorObject): TDoublePoint;
// ïîëó÷èòü ïîäúåì íà îáúåêòå
function GetRaiseConn(APointObject: TConnectorObject): TConnectorObject;
// ïîëó÷èòü ëèíèþ òèïà ñ-ï íà îáúåêòå
function GetRaiseLine(ARaiseConn: TConnectorObject): TOrthoLine;
// ïðîâåðèòü åñòü ëè ïîäúåì íà îáúåêòå
function CheckRaise(APointObject: TConnectorObject): Boolean;
// ïîëó÷èòü âåðøèíó ìåæýòàæíîãî îò òðàññû
function GetRaiseByRaiseLine(aRaiseLine: TOrthoLine): TConnectorObject;
// ïðîâåðèòü ñóùåñòâóåò ëè ëèñò
Function CheckListExist(AListID: integer): Boolean;
// Óñòàíîâèòü íîâûé òèï çàïîëíåííîñòè èíòåéôåéñîâ äëÿ ...
// òî÷. îáúåêòîâ
Procedure SetFullnessTypeForConnector(AID_List, AID_Figure: Integer; AFullnessType: TComponInterfacesFullness);
// êàáåëåé
Procedure SetFullnessTypeForCable(AID_List, AID_Figure: Integer; ASide: Integer; AFullnessType: TComponInterfacesFullness);
// êàáåëüíûõ êàíàëîâ
Procedure SetFullnessTypeForCableChannel(AID_List, AID_Figure: Integer; AFullnessType: TComponInterfacesFullness);
// çàêðûòîñòü/îòêðûòîñòü êàá.êàíàëîâ
Procedure SetClosedTypeForCableChannel(AID_List, AID_Figure: Integer; ASide: Integer; AClosedType: TComponInterfacesFullness);
// óñòàíîâèòü ñòèëü òðàññû
Procedure SetTraceStyle(AID_List, AID_Figure: Integer; ATraceStyle: TTraceStyle);
// ñðàâíåíèå äâóõ ÷èñåë òèïà Double
function DoubleCMP(Double1, Double2: Double): Boolean;
// ïåðåìåñòèòü îáúåêò íà ïåðåäíèé ïëàí
procedure SetConnBringToFront(AConnector: TConnectorObject);
// ïîëó÷èòü óêàçàòåëü íà ëèñò ãäå ìý ïåðåõîä
Function GetListOfPassage(AListID: Integer): TF_CAD;
function GetAllFiguresByClass(ACADForm: TF_CAD; aClass: TClass): TList;
function GetAllFiguresByClassFromProj(aClass: TClass): TList;
// ïîëó÷èòü îáúåêò ïî ëèñòó è ID îáúåêòà
function GetFigureByID(ACADForm: TF_CAD; AID_Figure: Integer): TFigure;
//2012-04-18 ïîëó÷èòü îáúåêò êîòîðûé áëèæå ê íà÷àëó êîîðäèíàò
function GetFigureByOrign(aFigureList: TList): TFigure;
function GetFigureByIDProj(AID_Figure: Integer): TFigure;
// ïîëó÷èòü îáúåêò ïî ëèñòó è ID îáúåêòà âíóòðè SCSFigureGroups
function GetFigureByIDInSCSFigureGroups(ACADForm: TF_CAD; AID_Figure: Integer): TFigure;
// ïîëó÷èòü îáúåêò ïî ID îáúåêòà âíóòðè SCSFigureGroup
function GetFigureByIDInSCSFigureGrp(ASCSFigureGrp: TSCSFigureGrp; AID_Figure: Integer): TFigure;
// ïîëó÷èòü SCSFigureGroup îáüåêò â êîòîðîì îáúåêò
function GetSCSFigureGrp(ACADForm: TF_CAD; AID_Figure: Integer): TSCSFigureGrp;
function AutoDivideLine(ALine: TOrthoLine): TConnectorObject;
// ðàçäåëèòü òðàññó, íà âûõîäå êîííåêòîð, êîòoðûé ðàçäåëèë ýòó òðàññó
function DivideLine(ALine: TOrthoLine): TConnectorObject;
function DivideLineSimple(ALine: TOrthoLine; ADivPt: PDoublePoint=nil): TConnectorObject;
// ñîåäèíèòü òðàññû ñâÿçóþùèå ñ êîííåêòîðîì
procedure DisconnectConn(AConn: TConnectorObject);
// ïåðåñ÷åò Z êîîðäèíàò ïðèâÿçàííûõ ëèíèé
procedure ReCalcZCoordSnapObjects(AConnector: TConnectorObject);
// Ïðîâåðêà íà êëàññ ÑÊÑ ...
// îðòîëèíèÿ
Function OrthoLineDetect(AOrthoLine: TFigure): Boolean;
// êîííåêòîð
Function ConnectorDetect(AConnector: TFigure): Boolean;
// îáùàÿ ïðîâåðêà íà îäèí èç êëàññîâ ÑÊÑ
Function SCSClassDetect(ASCSObject: TFigure): Boolean;
// ñîçäàâàòü îáúåêòû â ðåæèìå êëèêà íà ÊÀÄ-å
procedure CreateOnClickMode(ASnapFigure: TFigure; ALastSCSCompon: TSCSComponent; X, Y: Double);
procedure AskMarkInCreateObjectOnClick(aCAD: TF_CAD; aComponID: Integer);
// óñòàíîâèòü èíäåêñ îáúåêòà
procedure SetIndexToFigure(AID_List, AID_Figure: Integer; AIndex: Integer);
// óñòàíîâèòü ôîðìàò èçîáðàæåíèÿ òèïà êðàòêèé/ïîëíûé íà ÊÀÄ-å
procedure SetShowNameTypeInCAD(AShowType: TShowType);
// ïðîëîæèòü êîðîá ïî âûäåëåííûì ó÷àñòêàì
procedure TraceCableChannelBySelectedLines(CableChannelID: Integer);
// ïðîâåðèòü åñòü ëè õîòü îäíà âûäåëåííàÿ ëèíèÿ
function IsSelectedLinesExist: Boolean;
function IsSelectedFigure(aListID, aFigureID: Integer): Boolean;
// âûäàòü êîîðäèíàòû äðîïà îáúåêòà ñ ó÷åòîì ïðèâÿçêè ê ñåòêè
// ïî îñè X
function GetCoordXWithSnapToGrid(X: Double): Double;
// ïî îñè Y
function GetCoordYWithSnapToGrid(Y: Double): Double;
// ïî îáîèì îñÿì
function GetCoordsWithSnapToGrid(X, Y: Double): TDoublePoint;
// áûë ëè êëèê íà îáúåêòå
function IsClickOnFigure: Boolean;
// àâòîòðàññèðîâàòü êàáåëåì èç ÍÁ
Procedure AutoTraceCableFromNB(AID_Cable: Integer; ACable: TSCSComponent; aFromDropConnObj: Boolean=false; aShowFirstMsg: Boolean=true; aSaveForUndo: Boolean=true;
aNeedShowAutoTraceType: boolean = True; aFromDrop: boolean = False);
// òðàññèðîâàòü äî êîíå÷íîé òî÷êè
Function TracingToEndPoint(ACurrentWS, AEndPoint: TConnectorObject; AID_Cable: Integer; aConsiderBoxAndRack: Boolean=false): Boolean;
// ãëàâíûé öèêë àâòîòðàññèðîâêè
procedure DoAutoTraceCycle(AFiguresList: TList; AID_Cable: Integer; aConsiderBoxAndRack: Boolean=false; aSaveForUndo: Boolean=true);
// àâòîñîåäèíèòü ñ-ï íà ìåæýòàæíûõ ïåðåõîäàõ
Procedure AutoConnectBetweenFloorPassage(ACable: TOrthoLine; ASide: Integer; ARaise: TConnectorObject);
// ïðîâåðèòü ÿâëÿåòüñÿ ëè òðàññà ìåæýòàæíûì ñ-ï
Function GetBetweenFloorRaiseLine(ALine: TOrthoLine): TOrthoLine;
// ïðèìåíåíèå íàñòðîåê ïàðàìåòðîâ ëèñòà äëÿ âñåõ îáúåêòîâ
Procedure ApplyParamsForAllSCSObject(AConnHeight, ALineHeight: Double; AConnCaptionsShowType, AConnNotesShowType: TShowType; ALineCaptionsShowType, ALineNotesShowType: TShowKind; aCADParams: TCADParams);
// äëÿ òî÷å÷íûõ îáúåêòîâ
Procedure ApplyParamsForObjects(AObject: TConnectorObject; AHeight: Double);
// äëÿ ëèíåéíûõ îáúåêòîâ
Procedure ApplyParamsForTraces(ATrace: TOrthoLine; AHeight: Double; ATracesList: TList);
// ïðèìåíåíèå òèïà óãîëêîâ äëÿ âñåõ êîííåêòîðîâ
Procedure ApplyCornerTypeForConnectors(aCornerType: TCornerType);
// ïðîâåðêà ìîæíî ëè ñìåíèòü òèï óãîëêà äëÿ îáúåêòà
Function CheckCornertypeMaybeChanged(aConnector: TConnectorObject; aCornerType: TCornerType): Boolean;
// ïîëó÷èòü óãîë ìåæäó äâóìÿ òðàññàìè
function GetAngleBetweenLines(AListID, AIDLine1, AIDLine2, AIDConnector: Integer; aAngleType: TAngleType): Double;
Function CalcAngleBetweenLines(aLine1, aLine2: TOrthoLine; aConnector: TConnectorObject): Double;
// óñòàíîâèòü òèï óãîëêà
Function GetCornerTypeByConnectorID(AID_List, AID_Object: Integer): TCornerType;
// ïîëó÷èòü òèï óãîëêà
Procedure SetCornerTypeByConnectorID(AID_List, AID_Object: Integer; ACornerType: TCornerType);
// ïîëó÷èòü òèï óãîëêà ïî îïðåäåëåííûì çàêîíàì
Function GetCheckedCornerType(aConnector: TConnectorObject): TCornerType;
// ïîëó÷èòü ñòîðîíû ïðèñîåäèíåííûõ îáúåêòîâ (0 - åñëè êîííåêòîð, 1-2 - ñòîðîíû òðàññû)
Procedure GetSidesByConnectedFigures(AID_List1, AID_List2, AID_Figure1, AID_Figure2: Integer; var Side1: Integer; var Side2: Integer);
// ïîëó÷èòü âûñîòû òðàññû
Procedure GetLineFigureHeghts(AID_List, AID_Line: Integer; var AHeight1: Double; var AHeight2: Double);
// îáíîâèòü ñëîè ïîñëå èçìåíåíèÿ íàñòðîåê
procedure UpdateForLayers;
// îáíîâèòü âñå ÊÀÄû
Procedure RefreshAllLists;
// ïåðåäàòü â îáúåêò òèïû ñåòåé êîòîðûå â íåì ïðèñóòñòâóþò
Procedure SetNetworkTypesForObject(AID_List, AID_Object: Integer; ANetworkTypes: TObjectNetworkTypes);
// ïðîâåðèòü åñòü ëè ñîâïàäåíèÿ ñ ñåòÿìè
Function IsViewObjectInCurrentNetwork(AObject: TFigure): Boolean;
// óñòàíîâèòü äàííûå óñë.îáîçíà÷åíèÿ äëÿ îáúåêòà
Procedure SetBlockParamsForObject(AID_List, AID_Object: Integer; ABlockGUID: string; AObjectType: Integer; ABlockStreams, ABlockStreamsOtherType: TObjectList; aSysName: string = '');
// óñòàíîâèòü íîâîå ÓÃÎ äëÿ êîííåêòîðà
Procedure SetBlockForConnObject(AConnector: TConnectorObject; ABlockStreams: TObjectList; aSysName: string = '');
procedure SetLayerHandleForFigureGrp(BlockFig: TFigureGrp; LayHandle: integer);
// óñòàíîâèòü íîâîå ÓÃÎ äëÿ ëèíèè
Procedure SetBlockForLineObject(ALine: TOrthoLine; ABlockStreams, ABlockStreamsOtherType: TObjectList);
// âîçìîæíîñòü ñîåäèíåíèÿ íà ÊÀÄå, ìîãó ëè ýòè îáúåêòû ñîåäèíèòüñÿ íà ÊÀÄå
Function CheckCanConnectInCAD(AID_List1, AID_List2, AID_Object1, AID_Object2: Integer): Boolean;
// Âûâîäèòü èìÿ îáúåêòà íà ÊÀÄ â ïîäïèñè
procedure SetConnNameInCaptionOnCAD(AConnector: TConnectorObject);
// óñòàíîâèòü ïîäïèñü ê òî÷å÷íîìó îáüåêòó
procedure SetConnCaptionsInCAD(AID_List, AConnID: Integer; ACaption: TStringList);
// óñòàíîâèòü âûíîñêó íà òî÷å÷íîì îáúåêòå
procedure SetConnNotesInCAD(AID_List, AConnID: Integer; ANote: TStringList);
// óñòàíîâèòü âûíîñêó íà ëèíåéíîì îáúåêòå
procedure SetLineNotesInCAD(AID_List, ALineID: Integer; ANote: TStringList);
// óñòàíîâèòü ïîäïèñü íà ëèíåéíîì îáúåêòå
procedure SetLineCaptionsInCAD(AID_List, ALineID: Integer);
// êðàòêèé ôîðìàò Double
Function BriefFormat(ADbl: Double): Double;
// ïðîâåðêà èçìåíÿòü ëè ïîëÿ îáúåêòîâ ...
function CheckIsNameChanged(AID_List, AID_Figure: Integer): Boolean; // èìÿ
function CheckIsCaptionsChanged(AID_List, AID_Figure: Integer): Boolean; // ïîäïèñü
function CheckIsNotesChanged(AID_List, AID_Figure: Integer): Boolean; // âûíîñêà
function CheckIsBlockChanged(AID_List, AID_Figure: Integer): Boolean; // èçîáðàæåíèå
// ïîëó÷èòü ñïèñîê âñåõ ïðèñîåäèíåííûõ òðàññ ê îáúåêòó, èõ ID
Function GetAllConnectedTracesID(AID_List, AID_Object: Integer): TIntList;
// ïîëó÷èòü ñïèñîê âñåõ ïðèñîåäèíåííûõ òðàññ ê îáúåêòó, ñàìè îáúåêòû
Function GetAllConnectedTraces(AObject: TConnectorObject): TList;
// ïîèñê îáúåêòîâ (àíàëîã CheckByPoint)
Function CheckBySCSObjects(X, Y: Double; TracedFigure: TFigure = nil): TFigure;
procedure CheckBySCSObjectsNear(X, Y: Double; var ResFindedFigures: TList; TracedFigure: TFigure = nil);
// ïîèñê ñïèñêà îáúåêòîâ (àíàëîã CheckByPoint)
Function CheckBySCSObjectsList(X, Y: Double): TList;
// àâòîñäâèã òî÷. îáúåêòà
Procedure AutoShiftObject(AObject: TConnectorObject);
// ïîëó÷èòü ïðèñîåäèíåííûå òðàññû äëÿ óñòàíîâêè çàãëóøåê
Function GetObjectsListForCork(AListID, AID_LineFigure, ALineSide: Integer; var AID_Connector: Integer): TIntList;
// áëîêèðîâêà âñåõ äåéñòâèé ïîêà èäåò îáðîáîòêà ...
//Tolik
//Procedure BeginProgress(ACaption: String = ''; AMaxPos: Integer = -1); // íà÷àëî
Procedure BeginProgress(ACaption: String = ''; AMaxPos: Integer = -1; MustShowProgress: Boolean=False);
//
Procedure EndProgress; // îêîí÷àíèå
procedure SetCADsProgressMode(AIsProgress: Boolean);
procedure CADBeginUpdate(aCAD: TObject); //07.11.2011
procedure CADEndUpdate(aCAD: TObject); //07.11.2011
procedure StepProgress; // øàã
// ProgressBar ïðè çàãðóçêå ïðèëîæåíèÿ
procedure StartUpProgress;
// ïåðåèìåíîâêà ïðîåêòà - ïåðåèìåíîâàòü ïîëå FCADProjectList ó ëèñòîâ
Procedure SetListsNamesInProject(AProjectName: string);
// äîáàâëÿòü è óäàëÿòü shadow îáúåêòû ïðè DragOver c ÍÁ
procedure CreateShadowObject;
procedure DestroyShadowObject;
// âåðíóòü Stream ñ ÊÀÄîì ïî ÈÄ ëèñòó
function GetCADStreamByIDList(AID_List: Integer; aFileName: string = ''): TMemoryStream;
// ìîæíî ëè äâèãàòü DrawFigure
function IfDrawFigureMoveCan(AObject: TConnectorObject; ADeltaX, ADeltaY: Double): Boolean;
// ïåðåïðèñâîèòü ïàðàìåòðû ëèñòà Íàâèãàòîðó
procedure ReAssignNavigatorParams;
{****************************************************************************}
// çàãðóçêà íàñòðîåê äëÿ ëèñòà
Procedure LoadSettingsForList(AListID: Integer; aApplyListFormat: Boolean);
// çàãðóçêà íàñòðîåê äëÿ ëèñòà ïî ïàðàìåòðàì
procedure LoadSettingsForListByParams(AListParams: TListParams; aApplyListFormat: Boolean);
// Óñòàíàâëèâàåò ïàðàìåòðû â ðàìêó ëèñòà
procedure SetCADFrameParams(ACadForm: TF_CAD);
// ïåðåîòêðûâàòü çàêðûòûé ëèñò íà CAD
Procedure ReOpenListInCAD(AListID: Integer; const AListName: string);
// ïåðåîòêðûâàòü çàêðûòûé ëèñò íà CAD, ñ ïðîâåðêîé
Procedure ReOpenListInCADIfClosed(AListID: Integer; const AListName: string); //17.08.2012
// îòêðûòü ëèñòû â ïðîåêòå
procedure OpenListsInProject(AListID: Integer; AListName: string);
// ñäåëàòü äóáëèêàò äëÿ ëèñòà
function CreateListDuplicate(AListParams: TListParams; AListStream: TMemoryStream; AFileName: string = ''; aCopySCSFigures: Boolean=true): TF_CAD;
// âûãðóçêà ñòàðîãî ïðîåêòà
Procedure UnloadCurrentProject;
// çàãðóçêà íîâîãî ïðîåêòà
Procedure LoadNewProject(AListsID: TList; ACurrentListID: Integer);
// ñîçäàíèå/ðåäàêòèðîâàíèå ëèñòà
function MakeEditList(AMakeEdit: TMakeEdit; var AListParams: TListParams; AShowForm: Boolean;
ASpravochnikKind: TViewKind = vkNone; AGUIDToLocate: String = ''): Boolean;
// óòñàíîâèòü íîâûå ïàðàìåòðû äëÿ ëèñòà
procedure SetNewListParams(aCADParams: TCADParams);
procedure SetNewListParamsForMaster(aCADParams: TCADParams);
// ïðèìåíèòü íàñòðîéêè ê ïîäïèñÿì è âûíîñêàì
procedure ApplyCaptionNotesParams(aCADParams: TCADParams);
// óñòàíîâèòü ñòàòóñ ëèìèòíîñòè
procedure SetTraceLimitStatus(AID_List, AID_Object: Integer; AStatus: Boolean);
// STAMP
// çàãðóçèòü ðàìêó ëèñòà
procedure LoadFrameToList(aCad: TF_CAD; aMainStampName, aSideStampName: string; aListFormat: TListFormatType);
// óäàëèòü ðàìêó ëèñòà
procedure RemoveFrameFromList(aCad: TF_CAD);
// çàãðóçèòü ïîäïèñè íà ðàìêó ëèñòà
// ACreateForLack - Ñîçäàâàòü ïîäïèñü, åñëè îòñóòñòâóåò
procedure LoadCaptionsOnFrame(ACAD: TF_CAD; AStampType: TStampType; ACreateForLack: Boolean=true; AEnabledCaptions: TintList=nil);
// âïèñàòü ïîäïèñè ê ðàìêå ëèñòà â ïîëÿ
function CreateStampCaptionToField(ACAD: TF_CAD; aFieldBnd: TDoubleRect; const aText: String; ATextHorzCenter: Boolean=true; ATextSize: Integer=14): TRichText;
// Ïåðåñîçäàåò ïîäïèñü ê ðàìêå ëèñòà
function ReCreateStampCaptionToField(ACAD: TF_CAD; ACurrStampField: TRichText; ADataID: Integer; aFieldBnd: TDoubleRect; const aText: String;
ACreateForLack: Boolean=true; AEnabledCaptions: TintList=nil; ATextHorzCenter: Boolean=true; ATextSize: Integer=14): TRichText;
// ïîëó÷èòü èìÿ ôàéëà èç ïîëíîãî ïóòè
function GetFileNameFromFullPath(aFullPath: string): string;
// ïîëó÷èòü íîìåð ñëîÿ èç åãî Handle
function GLN(aLHandle: LongInt): integer;
// çàãðóçèòü ðàìêó íà ìàêåò
procedure LoadFrameOnMaket(aPCad: TPowerCad);
// äëÿ ëèñòà Äèçàéíà Øêàôà ...
// ñîçäàòü ëèñò Äèçàéíà øêàôà
procedure CreateDesignList(ABox: TConnectorObject);
// îòêðûòü äèçàéíåðñêèé ëèñò
procedure OpenDesignList(ABox: TConnectorObject; AList: TF_CAD);
// ñîçäàòü/îòêðûòü äèçàéí-ëèñò èç ìåíåäæåðà ïðîåêòîâ
procedure CreateOpenDesignListFromPM(AID_List, AID_Box: Integer);
// îáíîâèòü äèçàéíåðñêèé ëèñò
procedure UpdateDesignList(AList: TF_CAD; ABox: TConnectorObject);
// îáíîâèòü äèçàéíåðñêèé ëèñò ïîñëå èçìåíåíèÿ â îáúåêòå Øêàô
procedure UpdateDesignListOnBoxChange(AListID: Integer; ABoxID: Integer);
// ïåðåìàñøòàáèðîâàòü ÓÃÎ
procedure ReScaleImage(aBlock: TBlock; aCurrX, aCurrY, aTotalX, aTotalY: Double);
// âûñ÷èòàòü êîýô. ñ ó÷åòîì ïåðåìàñøàáèðîâàíèÿ ïî ëèñòó
function CalcListFormatKoef(aBoxWidth, aBoxHeight: Double; AList: TF_CAD): Double;
// íàðèñîâàòü ëèíåéêó ê äèçàéíó øêàôà ...
// â èåòðàõ
procedure DrawDesignRulerInMetres(aList: TF_CAD; aRulerHeight, aCadRulerWidth, aCadRulerHeight: Double; aBeginDrawPoint: TDoublePoint);
// â þíèòàõ
procedure DrawDesignRulerInUnits(aList: TF_CAD; aRulerHeight, aCadRulerWidth, aCadRulerHeight: Double; aBeginDrawPoint: TDoublePoint);
// îïöèè äëÿ òèïîâ ëèñòîâ (çàïðåò/ðàçðåøåíèå ïóíêòîâ ìåíþ)...
// äëÿ îáû÷íîãî ëèñòà
procedure EnableOptionsForNormalList;
procedure DisableActForReadOnlyMode;
// äëÿ Äèçàéíà øêàôà
procedure DisableOptionsForDesignList;
// äëÿ Ñõåìû ïðîåêòà
procedure DisableOptionsForProjectPlan;
// âûäàòü ïðèñîåäèíåííûå Îáüåêòû ê òðàññå
procedure GetConnObjectsByLine(AIDList, AIDLine: Integer; var AConnAtSide1: Integer; var AConnAtSide2: Integer);
// ïåðåèìåíîâàòü íàçâàíèÿ ïðîåêòà â ðàìêå ëèñòà
procedure RenameProjectOnFrame(AOldProjParams: TProjectParams);
// ïåðåèìåíîâàòü íàçâàíèÿ ëèñòà â ðàìêå ëèñòà
procedure RenameListOnFrame(ACadForm: TF_CAD; AOldProjParams: TProjectParams; AOldListParams: TListParams);
// ïðîâåðêà íà îòñîåäèíåíèå êîííåêòîðà îò îáúåêòà
function CheckByBreakConnector(aClearConn, aPointObject: TConnectorObject): Boolean;
// ïðîâåðêà íà îòñîåäèíåíèå êîííåêòîðà îò îáúåêòà ïî êîîðäèíàòàì êîííåêòîðà
function CheckByBreakConnectorByCoords(aConnPoints: TDoublePoint; aPointObject: TConnectorObject): Boolean;
// Îáíîâëåíèå ÊÀÄà (REFRESH)
procedure RefreshCAD(aPCAD: TPowerCad); // îáû÷íûé
procedure RefreshCAD_T(aPCAD: TPowerCad; AExecPrev: Boolean=false); // ïî òàéìåðó
procedure RefreshCADs(aCADs: TList); //17.01.2011 Îáíîâèòü ñïèñîê ëèñòîâ
// óñîâåðøåíñòâîâàííûé ProcessMessages
procedure ProcessMessagesEx;
// óäàëåíèå âíóòðè îáúåêòîâ FigureGrp (äëÿ êîððåêòðîé î÷èñòè îáúåêòîâ äàííîãî êëàññà)
procedure RemoveInFigureGrp(aFigureGrp: TFigureGrp);
// ïåðåðèñîâàòü òåê. Øàäîó òåêóùåãî ëèñòà
procedure ReDrawCurrShadowOnCAD;
// Unselect îáúåêòîâ íà SelectionChange (óáèðàåòñÿ ñåëåêò ñ ñ-ï è âåðøèí ñ-ï)
procedure UnSelectFiguresOnSelectedChange(aSelectedList: TList);
// ïåðåñ÷èòàòü äëèííû ëèíèé íà èçìåíåíèè Mapscale
procedure ReCalcAllLinesLength;
// ïîäíÿòü ActiveNet ïîñëå ïîäíÿòèÿ ëèñòà
procedure RaiseActiveNet(aCad: TF_CAD);
// Óñòàíàâëèâàåò ïàðàìåòðû ñ ÊÀÄà íà îáúåêò
procedure SetCADParamsToNet(aCad: TF_CAD; ANetObj: TObject);
procedure SetMapScaleToNets(aCad: TF_CAD);
// ïîëó÷èòü âñå âíóòðåííèå ôèãóðû ñ Stamp ...
// óñòàíîâèòü âèäèìîñòü äëÿ âíóòðåííèõ øòàìïîâ
procedure SetAllInFiguresVisible(AGroup: TFigureGrp; AVisible: Boolean);
// óñòàíîâèòü âñå âíóòð. îáúåêòàì ñëîé ñàìîãî îáúåêòà
procedure SetAllStampFiguresLayer(AGroup: TFigureGrp; ALHandle: Integer);
// óñòàíîâèòü âñåì âíóòð. òåêñòàì òåêóùèé øðèôò
procedure SetAllStampTextsFont(AGroup: TFigureGrp; aFontName: string);
// óñòàíîâèòü âñåì òåêñòîâûì îáúåêòàì íà ÊÀäå òåêóùèé øðèôò
procedure UpdateForTexts(aFontName: string);
// Ñìåíà ID ëèñòà
procedure ChangeObjectID(aListID, aOldID, aNewID: Integer);
// Ñìåíà ID êàáèíåòà
procedure ChangeCabinetID(aListID, aOldID, aNewID: Integer);
// âåðíóòü ID ìåæýòàæíûõ ïåðåõîäîâ ñ ëèñòà (ëèíèè)
function GetBetweenFloorObjectsID(AID_List: Integer; aClearJoins: Boolean = False): TIntList;
// óäàëÿòü ôèãóðû ñ ëèñòà ïåðåä óäàëåíèåì ëèñòà
procedure ClearFiguresonListDelete(aCAD: TF_CAD);
// çàïðîñ íà ïåðåìåùåíèå ëèñòîâ â ìåíåäæåðå ïðîåêòîâ
function CanListsInterchange(AIDMoveList, AID_List2: Integer; aMessRes: PInteger=nil; aMsg: Boolean=true): Boolean;
// Åñòü ëè íà ëèñòå ì.ý ïåðåõîäû
function CheckListWithFloorRaise(aListID: Integer): Boolean;
// âûäàòü ëèñò ñî âñåìè òèïàìè òðàññ
function GetTraceInfo(AID_List: Integer): TList;
// Ñðàâíèòü TStringList è TStrings
Function IsStringListsDifferent(aStringList: TStringList; aStrings: TStrings): Boolean;
// Êîíâåðòàöèÿ TFigureGrpNotMod â TRichTextMod ...
// ïîèñê îáúåêòîâ äëÿ êîíâåðòàöèè
procedure FindObjectsForConvertClasses;
// êîíâåðòèðîâàòü ïîäïèñè
Function ConvertCaptionsGroupToRichText(aCaptionsGroup: TFigureGrpNotMod; aIsLine: Boolean): TRichTextMod;
// êîíâåðòèðîâàòü âûíîñêè
Function ConvertNotesGroupToRichText(aNotesGroup: TFigureGrpNotMod; aIsLine: Boolean): TFigureGrpNotMod;
// ïîëó÷èòü ëèñò îáúåêòîâ îäíîãî óðîâíÿ
Function GetFiguresByLevel(aFigure: TFigure; X, Y: Double; aSameType: Boolean; ASort: Boolean=false): TList;
// ïîëó÷èòü ëèñò îáúåêòîâ íà îäíîé âåðòèêàëå
Function GetObjectsByVertical(aSelf, aSnapConnector: TConnectorObject): TList;
Function GetLinesByVertical(aSelf: TConnectorObject; aSnapLine: TOrthoLine): TList;
Function CheckVerticalInInterval(aVertical: TOrthoLine; aZ: Double): Boolean;
// óäàëèòü ì-ý ñ äðóãîãî ýòàæà
Procedure DeleteRaiseOtherFloor(aItRaise: TConnectorObject);
// äîëîæèòü êàáåëè ê ïðîòèâîïîëîæíîé òðàññå
Function MirrorCables(aClearConn: TConnectorObject; aNearTracedLine: TOrthoLine): Integer;
// ïîëó÷èòü ëèñò ì-ý ñ-ï äëÿ òðàññèðîâêè ÷åðåç íåñêîëüêî ýòàæåé ...
// ïðîâåðèòü ìîæíî ëè òðàññèðîâàòü ìåæäó ýòàæàìè
Function CheckCanTracingBetweenFloor(aLists: TIntList; aRaises: TList): Boolean;
// ïîëó÷èòü ñïèñîê ýòàæåé äëÿ òðàññèðîâêè ìåæäó íèìè
Function GetSortedListOfRaises(var aLists: TIntList; aRaiseType: TConnRaiseType; aEndPoint, aBeginPoint: TConnectorObject): TList;
// ïîëó÷èòü ñïèñîê ýòàæåé äëÿ òðàññèðîâêè ìåæäó íèìè íà÷èíàÿ îò òåêóùåãî
Function GetSortedListOfRaisesFromCurr(var aLists: TIntList; aRaiseType: TConnRaiseType; aBeginPoint, aEndPoint: TConnectorObject): TList;
// ïîëó÷èòü òðàññó îò ì-ý íà äðóãîì ýòàæå
Function IsBetweenFloorObject(AListID, AIDFigure: Integer; var AIDOtherFloorFigure: Integer): Boolean;
// óñòàíîâèòü ñòðóêòóðó ÊÀÄ ïàðàìåòðîâ
Function SetCADParamsStruct(aListParams: TListParams): TCADParams;
// ôóíêöèè äëÿ ñâîéñòâ ïîäïèñåé è âûíîñîê ...
// ïðîâåðèòü êëèê â îáëàñòè ïîäïèñè/âûíîñêè
Procedure CheckByCaptionsNotes(X, Y: Double);
// îòêðûòü ïîäïèñü îò äàííîãî îáúåêòà â ñâîéñòâàõ ÑÊÑ îáúåêòà
Procedure OpenCaptionAtPos(aObject: TFigure; aCaption: TRichTextMod; X, Y: Double);
// îòêðûòü âûíîñêó îò äàííîãî îáúåêòà â ñâîéñòâàõ ÑÊÑ îáúåêòà
Procedure OpenNoteAtPos(aObject: TFigure; aNote: TRichTextMod; X, Y: Double);
// ìîäèôèêàöèÿ âûíîñîê ïîñëå ïåðåìåùåíèÿ ...
// äëÿ êîííåêòîðîâ
procedure ModifyConnNoteAfterMove(aConn: TConnectorObject; aDeltaX, aDeltaY: Double);
// äëÿ òðàññ
procedure ModifyLineNoteAfterMove(aLine: TOrthoLine; aDeltaX, aDeltaY: Double);
// óñòàíîâèòü âûñîòó ðàçìåùåíèÿ îáúåêòà
procedure SetFigureCoordZ(AIDList, AIDFigure: Integer; ACoordZ: Double);
// ïîëó÷èòü òèï ñïóñêà-ïîäúåìà (ïîäúåì èëè ñïóñê)
Function GetRaiseType(aObjFromRaise, aRaise: TConnectorObject): TLineRaiseType;
// ïîëó÷èòü ôîðìàò ïîäïèñè ê ëèíèè
function GetLineCaptionFormat(aLine: TOrthoLine; aShowKind: TShowKind): string;
// ïîëó÷èòü ïîëíîå èìÿ îáúåêòà
Function GetFullFigureName(aFigure: TFigure; x: Double=-1; y: Double=-1): string;
function GetFullFigureLenName(aFigure: TFigure; x: Double=-1; y: Double=-1): string;
// àâòî ðàçðûâ ñîåäèíåíèÿ ñîåäíèíåíèÿ ÷åðåç ñ-ï ïîñëå óäàëåíèÿ ñ-ï
Procedure AutoDisconnectOverRaiseInCAD(AConnector, ARaiseConnector: TConnectorObject; ARaiseLine: TOrthoLine);
// ðåäàêòèðîâàíèå óñëîâíîãî îáîçíà÷åíèÿ
Procedure EditBlockOnCAD(aActiveBlockStream, aProjectBlockStream: TMemoryStream);
// ôóíêöèè ïåðåíîñà îáúåêòà íà âûñîòó îñíîâàíèÿ/âåðøèíû
// ñìåíà âûñîò ìåæäó ÐÌ è ÐÌ
procedure RemoveRMWithRM(aRM1, aRM2: TConnectorObject);
// ñìåíà âûñîò ìåæäó ÐÌ è ïóñòûì ñîåäèíèòåëåì
procedure RemoveRMWithClear(aRM, aClear: TConnectorObject);
// ðåâåðñèðîâàòü âåðøèíó ñ-ï (ÒÎ) ñ îñíîâàíèåì (ïóñòîé)
procedure ReverseRaise(aPointObject: TConnectorObject);
// ïðîâåðèòü, ÷òî ëèñò îáû÷íîãî òèïà
function CheckListNormalType(aListID: Integer): Boolean;
// âûçâàòü ñõåìó ïðîåêòà èç ÍÁ
procedure CallProjectPlanFromNB;
// Êàáèíåòû ...
// ñîçäàòü êàáèíåò íà ÊÀÄå
procedure CreateCabinetOnCAD(aSCSID, aIndex: Integer);
// óäàëèòü êàáèíåò íà ÊÀÄå
procedure DeleteCabinetOnCAD(AID_List, aSCSID: Integer);
// âûäåëèòü êàáèíåò íà ÊÀÄå
procedure ActivateCabinetOnCAD(AID_List, aSCSID: Integer);
// óáðàòü âûäåëåíèå ñ êàáèíåòà íà ÊÀÄå
procedure DeactivateCabinetOnCAD(AID_List, aSCSID: Integer);
// íàéòè êàáèíåò ïî åãî ID
function FindCabinetBySCSID(aList: TF_CAD; aSCSID: Integer): TFigure;
// ñîçäàòü îáúåêò íîìåð êàáèíåòà äëÿ êàáèíåòà íà ÊÀÄå
function CreateNumberObjectOnCAD(aCabinet: TFigure; aVisible: Boolean): TCabinetNumber;
// èçìåíèòü ïàðàìåòðû êàáèíåòà
procedure ChangeCabinetParams(AID_List: Integer; AObjectParams: TObjectParams);
// óñòàíîâêà âèäèìîñòè/íåâèäèìîñòè íîìåðîâ êàáèíåòîâ
procedure SetVisibleCabinetsNumbers(aVisible: Boolean);
// óñòàíîâêà âèäèìîñòè/íåâèäèìîñòè ãðàíèö êàáèíåòîâ
procedure SetVisibleCabinetsBounds(aVisible: Boolean);
// ïîëó÷èòü êàáèíåò â êîòîðîì íàõîäèòñÿ óêàçàííûé îáúåêò
function GetCabinetWhereObject(aObject: TFigure): TFigure;
// ïîëó÷èòü êàáèíåò â äàííîé òî÷êå ÊÀÄà
function GetCabinetAtPos(aX, aY: double; aCheckAllFigInside: boolean = True; aMovedFigure: TFigure = nil): TFigure;
// ïåðåìåñòèòü îáúåêòû íà ÊÀÄå â êàáèíåò ïðè ñîçäàíèè
procedure MoveObjectsToCabinetOnCreate(aCabinet: TFigure);
// ïåðåìåñòèòü îáúåêòû íà ÊÀÄå â êàáèíåò ïðè ïåðåìåùåíèè
procedure MoveObjectsToCabinetOnMove(aCabinet: TFigure);
// íàéòè âèðòóàëüíûé êàáèíåò
function GetVirtualCabinet: TFigure;
// ïîêàçûâàòü ëè âûíîñêó (åñëè îíà ïóñòàÿ òî îíà íå îòîáðàæàåòñÿ)
function IsNoteExist(aNoteObject: TFigureGrpNotMod): Boolean;
// óòèëèòû äëÿ óäàëåíèÿ ñ-ï ïîñëå íåêîòîðûõ èçìåíåíèé â ñëó÷àÿõ êîãäà îíè ïóñòûå è íå ïðèñîåäèíåííûå ...
// ïðîâåðèòü âñå ñ-ï íà ÊÀÄå
procedure CheckDeleteAllRaises(aPCad: TPowerCad);
// óäàëèòü äàííûé ñ-ï åñëè ýòî ñëåäóåò äåëàòü
procedure CheckDeleteRaise(aRaiseLine: TOrthoLine);
// ïðîâåðêà ìîæíî ïóñòîé è íå íóæíûé ëè Ñ/Ï
function isRaiseEmptyAndNotNeed(aRaiseLine: TOrthoLine): boolean;
// âûäåëåí ëè îáúêò íà ÊÀÄå
function CheckCADObjectSelect(AID_List, AID_Object: Integer): Boolean;
// âûäàòü ñïèñîê âñåõ ïóòåé îò âñåõ ÐÌ íà ëèñòå (äëÿ êîíôèãóðàòîðà)
function GetPointObjectsRelations(AID_List: Integer): TObjectList;
// ïîñëå èçìåíåíèÿ Mapscale íà ÊÀÄå èçåíåíèòü äàííûå âñåõ èçìåðèòåëüíûõ ëèíèé
Procedure ReScaleAllDimLines;
// ïðîâåðêà, óäàëåí ëè îáúåêò
Function CheckObjectDeleted(AID_List, AID_Object: Integer): Boolean;
// ìîäèôèêàöèÿ ïîäïèñè ïîñëå ñìåíû òèïà ïîäïèñè
procedure ReverseCaptionAfterTypeChange(aLine: TOrthoLine; aOldType, aNewType: TShowKind);
// óñòàíîâêà òèïà ðàçìåðíûõ ëèíèé
procedure SetDimLinesType(aType: TDimLinesType);
// ïðîâåðêà íà òèï îáúåêòà Êðîññ ÀÒÑ èëè ÐØ
function CheckTrunkObject(aObject: TConnectorObject): Boolean;
// ñîçäàíèå äóáëèêàòîâ èç öåïè âûäåëåííûõ ÑÊÑ îáúåêòîâ
function CreateSCSObjectDuplicates(ACad: TF_CAD; aObjects: TList): TList;
// ïîëó÷èòü ïðèâÿçàííûé êîííåêòîð äëÿ âîññòàíîâëåíèÿ ïðèâÿçêè ïîñëå äóáëèðîâàíèÿ öåïè
function GetJoinedConnForDuplicate(aClearConns: TList; aParentDupID: Integer): TConnectorObject;
// àâòî ñîåäèíåíèå èíòåðôåéñîâ ïîñëå ðàçäåëåíèÿ òðàññû
Procedure AutoConnectOverDivideLine(AConnDivider, AConnOther: TConnectorObject; ADividedLine, ANewLine: TOrthoLine);
// àâòî ðàññîåäèíåíèå èíòåðôåéñîâ ïîñëå ñëèÿíèÿ òðàññû
Procedure AutoDisconnectOverDivideLine(AConn1, AConn2: TConnectorObject; ALine: TOrthoLine);
// ïîëó÷èòü îáúåêòà íà ÊÀÄå ïî ID â âèäå TObject
function GetFigureObjectByID(aListID, aObjectID: Integer): TFigure;
// óñòàíîâèòü íîâûå ID äëÿ îáúåêòîâ
procedure SetNewObjectsIDs(aObjects: TObjectList; aIDs: TIntList);
// ìîæíî ëè óäàëÿòü îáúåêò ñ ÌÏ
function CanDeleteObjectFromPM(aListID, aObjectID: Integer): Boolean;
// óñòàíîâèòü âñå òðàññû â íóæíûé ðåæèì îòîáðàæåíèÿ äëèíû ...
// óñòàíîâèòü âñåì òðàññàì àâòî äëèííó
procedure SetAllTracesAutoLength;
// óñòàíîâèòü âñåì òðàññàì ïîëüçîâàòåëüñêóþ äëèííó
procedure SetAllTracesUserLength;
// ïðîâåðêà îáúåêòà íà èìÿ êëàññà
function CheckFigureByClassName(aFigure: TFigure; const aClassName: string): Boolean;
function CheckFigureByClassIdx(aFigure: TFigure; const aClassIdx: Integer): Boolean;
// óñòàíîâêà îáúåêòó ïðèñóòñòâóåò èëè íåò äðóãîé òèï êîìïëåêòóþùåé
procedure SetExistOtherObjectType(aListID, aObjectID: Integer; aExist: Boolean);
// ïîëó÷åíèå íîìåðà ìàãèñòðàëè íà êðîññ ÀÒÑ äëÿ òðàññû (âíåøíèå ÑÊÑ)
function GetTrunkNumber(aLine: TOrthoLine): string;
// Ãðóïïèðîâêà âûäåëåííûõ ÑÊÑ îáúåêòîâ
function SCSGroupSelection: TSCSFigureGrp;
// Ãðóïïèðîâêà çàäàííûõ ÑÊÑ îáúåêòîâ
function SCSGroupObjects(aObjects: TList): TSCSFigureGrp;
// Ðàçãðóïïèðîâêà ÑÊÑ îáúåêòîâ
Procedure SCSUngroupSelection;
// çàëî÷åí ëè îáúåêò
function IsLockedObject(aListID, aObjectID: Integer): Boolean;
// ðàññîåäèíåíèå òðàññ
procedure DisconnectTraces(aConn: TConnectorObject);
// îòñîåäèíåíèå ÒÎ
procedure DisconnectPointObject(aObject: TConnectorObject);
// óäàëåíèå âñåõ òðàññ íà ëèñòå
procedure DeleteAllTraces;
// óäàëåíèå SCSFigureGrp
procedure DeleteSCSFigureGrps(aListID: Integer);
// ïðîâåðèòü åñòü ëè ÷òî òî êðîìå ãðóïïèðîâêè
function CheckAnyButFigureGrp(aFiguresList: TList): Boolean;
// ïðèìåíèòü ïðîöåíò ðàçìåðà ÓÃÎ äëÿ îáúåêòà
procedure ChangeDrawFigurePercentForObject(aObject: TConnectorObject; aPercent: Double);
// ïðèìåíèòü ïðîöåíò ðàçìåðà ÓÃÎ äëÿ òðàññû
procedure ChangeDrawFigurePercentForLine(aLine: TOrthoLine; aPercent: Double);
// îòäàòü äëèííó òðàññû
function GetTraceLength(aListID, aTraceID: Integer): Double;
// çàêðûòü ôîðìó ÊÀÄà
procedure CloseCad(aListID: Integer);
// óñòàíîâêà ðåæèìà íàëè÷èÿ èçìåíåíèé â ïðîåêòå
procedure SetProjectChanged(aChanged: Boolean);
// ïîëó÷èòü ñòðóêòóðó ïàðàìåòðîâ ÓÃÎ îáúåêòà
function GetFigureIconParams(aListID, aObjectID: Integer): TFigureIconParams;
// óòèëèòà ñîðòèðîâêè ÐÌ äëÿ àâòîòðàññèðîâêè
function GetSortedListForAutoTrace(aFiguresList: TList): TList;
// ïîëó÷åíèå ÓÃÎ îáúåêòà ïî ID
function GetObjectBlockbyID(aListID, aObjectID: Integer; aCanLoadIcons: Boolean): TObjectIconParams;
// ïîëó÷åíèå Stream ÓÃÎ îò îáüåêòà
function GetObjectBlockStream(aListID, aObjectID: Integer): TMemoryStream;
// Óñòàíîâèò ÓÃÎ îáúåêòà â ïîäëîæêó
function GetObjectBlockToSubstrateLayer(aListID, aObjectID: Integer): Boolean;
// ïðè àâòîòðàññèðîâêå îêíî ïîðÿäêà âûáîðà ïîäêëþ÷åíèé ê ïàíåëÿì
function ChoiceAutoTraceConnectOrder(AProjectSetting: PProjectSettingRecord = nil; AIsTracing: Boolean = true;
ATraceCompon: TSCSComponent=nil; aFromDropConnObj: Boolean=false; aTracingFigInfo: Pointer=nil): Boolean;
// óáðàòü Øàäîó ñî âñåì òðàññ
procedure SkipAllLinesShadows(aForm: TF_CAD);
// ïå÷àòü íåñêîëüêèõ ëèñòîâ
procedure PrintCADLists(aAllLists, aCheckedLists: TIntList);
// àâòîðàçìåùåíèå òðàññ íà âûñîòó ÐÌ ìæäó íèìè
procedure AutoPosTracesBetweenRM(aConns, aTraces, aSnaps: TList);
// àâòîðàçìåùåíèå òðàññ íà âûñîòó ÐÌ ìæäó íèìè ïîñëå âñåõ ïðèâÿçîê
procedure AutoPosTracesBetweenRMAfterSnap(aTraces: TList);
// óñòàíîâèòü âûñîòó ôàëüø-ïîòîëêà äëÿ êàáèíåòà
procedure SetCabinetFalseFloor(aCabinet: TFigure);
// ïðîâåðèòü âñå âûñîòû êàáèíåòîâ íà ïðåäìåò ïðåâûøåíèÿ âûñîòû ôàëüø ïîòîëêà îòíîñèòåëüíî âûñîòà ýòàæà
procedure CheckAllCabinetsFalseFloorHeights;
// óñòàíîâèòü ôîðìàò ÊÀÄ ëèñòà
procedure SetCadListFormat(aListFormat: TListFormatType);
// óñòàíîâèòü âûñîòó ôàëüø-ïîòîëêà äëÿ êàáèíåòà èç ÌÏ
procedure SetCabinetFalseFloorHeightFromPM(aListID, aCabinetID: Integer; aSettings: TRoomSettingRecord);
// ïðîâåðèòü èçìåíÿëèñü ëè êàêèå òî ïàðàìåòðû ëèñòà
function CheckListFormatChanged(aCad: TF_CAD; aListFormat: TListFormatType): Boolean;
// âîññòîíîâëåíèå âèçèáë/èíâèçèáë äëÿ øòàìïîâ è íàäïèñåé ðàìêè ëèñòà ïîñëå çàãðóçêè
procedure CorrectStampView;
// åñëè òðàññà ãîðèçîíòàëüíàÿ
function IfTraceHorizontal(aTrace: TOrthoLine): Boolean;
// åñëè òðàññà âåðòèêàëüíàÿ
function IfTraceVertical(aTrace: TOrthoLine): Boolean;
// ïîëó÷åíèå êîë-âà ì-ý âåðøèí ó ïðèñîåäèíåííîé ê çàäàííîé òðàññå
function GetRaiseCountConnectedToFigure(AIDList, AIDFigure: Integer): Integer;
// ïåðåñòàâèòü âñå âûñîòû ìåæýòàæíûõ ïîäúåìîâ ïîñëå èçìåíåíèÿ âûñîòà ýòàæà
procedure SetAllBetweenFloorRaises;
// ñåé÷àñ èäåò ñîçäàíèå òðàññû
function IsNowTracingByUser: Boolean;
// ñåé÷àñ íà ÊÀÄå íàæàòà ëåâàÿ êíîïêà ìûøè
//function IsMousedPressed: Boolean;
// ïðîöåäóðû äëÿ ñäâèãà ÓÃÎ äëÿ îáüåêòîâ è òðàññ
// ÓÃÎ îáúåêòà ââåðõ
procedure ObjectsShiftUp(aObjList: TList);
// ÓÃÎ îáúåêòà âíèç
procedure ObjectsShiftDown(aObjList: TList);
// ÓÃÎ îáúåêòà âëåâî
procedure ObjectsShiftLeft(aObjList: TList);
// ÓÃÎ îáúåêòà âïðàâî
procedure ObjectsShiftRight(aObjList: TList);
// ÓÃÎ òðàññû ââåðõ
procedure LinesShiftUp(aLinesList: TList);
// ÓÃÎ òðàññû âíèç
procedure LinesShiftDown(aLinesList: TList);
// ÓÃÎ òðàññû âëåâî
procedure LinesShiftLeft(aLinesList: TList);
// ÓÃÎ òðàññû âïðàâî
procedure LinesShiftRight(aLinesList: TList);
// óñòàíîâêà çíà÷åíèÿ "Åñòü êàáåëüíûé êàíàë"
procedure SetIsCableChannel(aListID, aLineID: Integer; aFlag: Boolean);
// UNDO äëÿ ïðîåêòà ...
procedure SaveForProjectUndo(aLists: TList; aSavePM: Boolean; aIsProject: Boolean);
// óäàëèòü âñþ öåïî÷êó Undo â ñâÿçêå ñ äðóãèìè ýòàæàìè
procedure DeleteProjectUndoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction);
// ïîäíÿòü âñþ öåïî÷êó UNdo â ñâÿçêå ñ äðóãèìè ýòàæàìè
procedure LoadProjectUndoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction);
// âûçîâ ñîõðàíåíèÿ ëèñòà èëè íåñêîëüêèõ ëèñòîâ äëÿ Undo èç Ìåíåäæåðà ïðîåêòîâ
procedure SaveForUndoFromPM(aListsIDs: TIntList; aIsProject: Boolean = False);
// REDO äëÿ ïðîåêòà ...
procedure SaveForProjectRedo(aLists: TList; aSavePM: Boolean; aIsProject: Boolean);
// óäàëèòü âñþ öåïî÷êó Undo â ñâÿçêå ñ äðóãèìè ýòàæàìè
procedure DeleteProjectRedoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction);
// ïîäíÿòü âñþ öåïî÷êó UNdo â ñâÿçêå ñ äðóãèìè ýòàæàìè
procedure LoadProjectRedoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction);
// âûçîâ ñîõðàíåíèÿ ëèñòà èëè íåñêîëüêèõ ëèñòîâ äëÿ Undo èç Ìåíåäæåðà ïðîåêòîâ
procedure SaveForRedoFromPM(aListsIDs: TIntList; aIsProject: Boolean = False);
// ïîëó÷èòü ÈÄ äðóãîãî ëèñòà íà êîòîðîì ñâÿçü ñ ìåæýòàæíûì
function GetOtherListRelatedToFigure(AListID, AFigureID: Integer): Integer;
// ïðè ïåðåìåùåíèè è óäàëåíèè ïðîâåðèòü çàäåéñòâîâàíû ëè äðóãèå ëèñòû, âûäàòü ñïèñîê ëèñòîâ
function GetRelatedListsBySelected(aObjects: TList; aCheckBySelectedType: TCheckBySelectedType): TList;
// ïðîâåðèòü ÷òî ýòî îäèí èç ÑÊÑ ñëîåâ (2, 3, 4, 5, 6, 8, 9)
function CheckOneOfSCSlayers(aLNbr: Integer): Boolean;
// óáðàòü âûäåëåíèå ñî âñåõ ÑÊÑ îáúåêòîâ íà óêàçàííîì ëèñòà
procedure DeselectAllSCSObjectsInCAD(AListID: Integer);
// óáðàòü âûäåëåíèå ñî âñåõ ÑÊÑ îáúåêòîâ íà âñåõ ëèñòàõ
procedure DeselectAllSCSObjectsInProject;
// óáðàòü âûäåëåíèå ñ íåîòðèñîâàíûõ îáúåêòîâ
procedure DeselectNoDrawed(aPCAD: TPowerCad);
// âûäåëèòü ãðóïïó îáúåêòîâ
procedure SelectObjectsInCADByIDs(aListID: Integer; aObjectsID: TIntList);
// ïîëó÷èòü èíòëèñò ñ âûäåëåííûìè îáúåêòàìè íà ÊÀÄå
function GetObjectsListWithSelectedInCAD(aListID: Integer): TIntList;
// ïîëó÷åíèå íîâîñòåé
function Get_News(ParentWin : THandle; gpid, gURL_p, gURL_a, gfil : string; func : byte; var timr :word): byte;
// àâòîïîäãîíêà èçîáðàæåíèÿ ïîä ôîðìàò ëèñòà
procedure ReScaleDrawingToListFormat(aOldListW, aOldListH: double);
// ñîçäàíèå âèðòóàëüíîãî êàáèíåòà íà ÊÀÄå
procedure CreateVirtualCabinetInCAD(vList: TF_CAD);
// óäàëåíèå äõô ñëîåâ
procedure DeleteDxfLayers(aPCad: TPowerCad);
// ïðîâåðèòü ÷òî îáüåêò íàõîäèòñÿ íà îäíîì èç ÄÕÔ ñëîåâ
function CheckFigureInDXFLayer(aFigure: TFigure): Boolean;
// ïðèìåíèòü ñèñòåìó èçìåðåíèé
procedure ApplyUOMForProject(aOldUOM, aNewUOM: Integer);
// ïîëó÷èòü îáîçíà÷åíèå ñòðèãíîâîå ñèñòåìû èçìåðåíèé
function GetUOMString(aUOM: Integer): string;
// ïåðåâåñòè ìåòðû â òåêóùóþ ñèñòåìó èçìåðåíèé
function MetreToUOM(aValue: Double): Double;
// ïåðåâåñòè òåêóùóþ ñèñòåìó èçìåðåíèé â ìåòðû
function UOMToMetre(aValue: Double): Double;
// îáíîâèòü âñå äëèíû òðàññ íà âñåõ ëèñòàõ ïîñëå ñìåíû ÑÈ
procedure UpdateAllTracesLengthOnAllLists;
// ïîëó÷èòü ïëîùàòü è îáúåì êàáèíåòà â ìåòðàõ
function GetRoomSquare(AListID, ARoomID: Integer; RecalcSquare: Boolean = False): Double;
//Tolik
//function GetRoomVolume(AListID, ARoomID: Integer ): Double;
function GetRoomVolume(AListID, ARoomID: Integer; ARoomSquare: Double): Double;
// ïðåîáðàçîâàíèå TList â TIntList è íàîáîðîò äëÿ ñïèñêà ëèñòîâ ÊÀÄà
function CadsToIntCads(aList: TList): TIntList;
function IntCadsToCads(aIntList: TIntList): TList;
function FiguresToIntFigures(aList: TList): TIntList;
function IntFiguresToFigures(aIntList: TIntList): TList;
// ïðîâåðèòü åñòü ëè ì-ý ñ-ï íà ëèñòå
function CheckExistBetweenFloorOnList(aCad: TF_CAD): Boolean;
// âðåìåííàÿ ôóíêöèÿ äëÿ ÄÕÔ (åñòü ëè TTEXT â áëîêå)
function CheckTTextExistForDXF(aBlock: TBlock): Boolean;
// ÏÎËÓ×ÈÒÜ ÁÌÏ ñ ïîäëîæêîé è àðõ. ïëàíîì
procedure SaveSubstrateArchPlan(aFileName: string);
procedure ConvertBMPToJpeg(aBmp: TBitmap; aFileName: string);
// Äëÿ Äîìà
Procedure SelectHouseInCAD(AID_List, AID_Figure: Integer);
Procedure SelectApproachInCAD(aListID, aHouseID, AComponID: Integer);
procedure DeleteHouseOnCAD(aListID, AObjectID: Integer);
procedure DeleteApproachOnCAD(aListID, aHouseID, AComponID: Integer);
function GetIDElementFromComplexObjByTrace(AID_List, AIDComplexFigure, AIDTrace: Integer): Integer;
function GetHouseByID(ACADForm: TF_CAD; AID_Figure: Integer): THouse;
function GetApproachByComponID(ACADForm: TF_CAD; AID_Compon: Integer): TConnectorObject;
function GetEndPointByHouse(aHouse: THouse; aCurrentWA: TConnectorObject): TConnectorObject;
// From BaseCommon
function GetConnectedTracesToConnetorByID(AIDList, AIDConnectorFigure: Integer): TIntList;
// Ïîëó÷èòü ñïèñîê ïîäñîåäèíåííûõ îáúåòîâ
// (AClearConnToRes = true) ?  ðåçóëüòàò ïîïàäóò ñîåäèíèòåëè òðàññû : ïîäêëþ÷åííûå òðàññû
function GetConnectedFigures(AFigure: TFigure; AClearConnToRes: Boolean=false; ASkipList: TList=nil): TList; //#From Oleg# //15.09.2010
//24.07.2013 Âåðíåò ñîåäèíèòåëè ñ äðóãèõ ñòîðîí ñîåäèíåíí³õ ñòðàññ îò ñîåäèíèòåëÿ
function GetConnectorsOtherSides(aConnector: TConnectorObject): TList;
procedure SetLineStatusInfo(aLineParams: PLineFigureParams);
procedure SetConnStatusInfo(aConnParams: PConnFigureParams);
procedure SetLiteStatus(aStatus: Boolean);
procedure LoadSubWithMaster(aFName: string);
procedure CreateVerticalOnConnector(aConnector: TConnectorObject; aHeight: Double);
procedure CreateVerticalOnPointObject(aPointObject: TConnectorObject; aHeight: Double);
// Tolik
// âåðòèêàëüíàÿ ëèíèÿ ïî äâóì òî÷êàì
procedure CreateVerticalOnTwoPointObjects(aPointObject1, APointObject2: TConnectorObject; aHeight: Double);
function CheckOtherConnectorsOnLevel(aSelf: TConnectorObject; X, Y: Double): TList;
function CheckJoinVertical(aObject: TConnectorObject): Boolean;
procedure PutObjectOnHeight(aObject: TConnectorObject; aHeight: Double);
// Èùåò ñïèñîê îáúåêòîâ ïî âåðòèêàëè, ïîäêëþ÷åííûå ÷åðåç AObject
function GetJoinedVerticalObjects(AObject: TFigure; AOnlyConnectorCoordZ: PDouble=nil): TList; //#From Oleg# //15.09.2010
function GetJoinedVerticalConnectorByCoordZ(AStartConnector: TConnectorObject; ACoordZ: Double): TConnectorObject;
// Âåðíåò íîìåð ñëîÿ äëÿ êîìïîíåíòà
function GetCADLayerNumByComponIsLine(AIsLine: Integer): Integer;
procedure DefineCurrLayerByCompon;
procedure DropCreateObjectOnClickMode;
// Äëÿ áëîêîâ
procedure BlockToNormalSize(ABlock: TBlock; AMaxSideSize: Integer);
procedure Remove3DModelStream;
// Ñîçäàåò òðàññó ñ ñîåäèíèòåëÿìè
function CreateTraceByPoints(APCAD: TPowerCad; AP1, AP2: TDoublePoint; aPosTraceBetweenPM: boolean = false; aH1: double = 0; aH2: double = 0): TOrtholine;
function CreateTraceByConnectors(aCAD: TF_CAD; aConn1, aConn2: TConnectorObject; aOrthogonally: Boolean=false; aTraceBetweenPM: Boolean = False): TOrtholine;
// Ðàçäåëèòü òðàññó â òî÷êå
function DivTraceOnPt(ATrace: TOrtholine; APt: TDoublePoint; ATraceList: TList): TConnectorObject;
// Âåðíåò ñîåäèíèòåëü êîòîðûé áëèæå ê íà÷àëó êîîðäèíàò
function GetMinConnector(AConn1, AConn2: TConnectorObject): TConnectorObject;
procedure ChangeObjZ(aObject: TConnectorObject; aZ: Double);
// Ñîçäàåò òðàññû ìåæäó òî÷.îáúåêòàìè
function AutoCreateTraces(aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): Integer;
function AutoCreateTracesParallel(aSrcFigure: TFigure; aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): Integer;
function AutoCreateTracesToTraceList(aTraces: TList; aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): Integer;
function AutoCreateTracesMaster(aSrcFigure: TFigure): Boolean;
function GetConnFiguresForAutoCreateTraces(aCad: TF_CAD; aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): TList;
// Ðàçäåëÿåò òðàññû íà ñòåíàõ êàáèíåòàõ
procedure DivideTracesOnRoowWalls(aCad: TF_CAD);
//15.03.2014 - Ïðèìåíèòü ñâîéñòâî "ðàçìåð îòðåçêà"
procedure ApplySectionSideForTraces(aCad: TF_CAD);
// Óñòàíàâëèâàåò òî÷.êîìïîíåíòû íà òðàññû ñ øàãîì
procedure SetConnComponToTraces(aCad: TF_CAD; ACompon: TSCSComponent; AStep: Double; ASetToConnectors: Boolean);
procedure MirrorFigure(AFigure: TFigure);
// Ñäâèãàåò îáúåêòû èç ñïèñêà
procedure MoveFigures(AFigures: TList; x, y: Double);
procedure RotateFigure(AFigure: TFigure; Angle: Double);
procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor);
// Äëèíà äóãè
function GetArcLen(Radius, RadAngle: Double): Double; overload;
function GetArcLen(CenterPoint, LinePoint: TDoublePoint; RadAngle: Double): Double; overload;
function GetArcLenByPoints(p1, p2, ArcCenter: TDoublePoint; AInverted: Boolean): Double;
function GetPolylineFromArc(ACornerCount: Integer; cp:TdoublePoint; radius, ArcAng: Double; p1, p2: PDoublePoint): TDoublePointArr;
// Óãîë ìåæäó ëèíèÿìè
function GetLinesAngle(AP1, AP2, AP3, AP4: TDoublePoint): Double;
function GetAreaFromPolygon3D(APoints: PDoublePointArr): Double;
function GetPerimetrFromPolygon(APoints: PDoublePointArr): Double;
procedure GetLinesNearPoints(ap1, ap2, bp1, bp2: PDoublePoint; var ap, bp: TDoublePoint);
function IsConvexPolygon(APoints: PDoublePointArr; ALastPtInFirst: Boolean): Integer;
function OverlapDoubleRects(const R1, R2: TDoubleRect): Boolean;
function CorrectAngle(aAngle: Double; AStep: Integer=360): Double;
function GetTextHeight(FontHandle: HWND; AFont: TFont): Double;
procedure GetTextSize(AFontSize: Integer; AStyles: TFontStyles; const AFontName, AText: String; AStrings: TStrings;
var h, w: Double; AStrH: Pointer=nil);
function DefineFrameByPrinter(aRect: TDoubleRect): TDoubleRect;
function RoundN(Num: Extended; Dig: integer): Extended;//Extended;
Function CheckAssignedPCAD(aPcad: TPCDrawing): Boolean;
// From Dimon ;)
//Îòñîåäèíÿåì íóæíûå íàì ñîåäèíåíèÿ...
Procedure ClearLineInterfaces(APointObject, AConnector: TConnectorObject; var CurrLine: TOrtholine; FindFreeInterfac: Boolean);
//Ïðîâåðÿåì, ÷òîá ïàðàìåòðè áûëû îäèíàêîâûìè
Function CheckInterfacesSideSection(APointObject, AConnector: TConnectorObject; CurrLine: TOrtholine): Boolean;
//Ïðîâåðÿåì òåêóùóþ Îðòîëèíèþ íà íàëè÷èå ñâîáîäíûõ èíòåðôåéñîâ
Function CheckCurrLine(CurrLineInterf: TSCSInterfaces; APointObject: TConnectorObject):Boolean;
//Ôóíêöèÿ ñðàâíèâàåò ïàðàìåòðû âûáðàííîãî êîìïîíåíòà èç äåðåâà ñ òåì, ÷òî óæå èìååòñÿ íà êàäå
Function CheckComponentsForSideSection(CurrCompon: TSCSComponent):Boolean; //From Dimon ;)
function GetMultipleFromNB:Boolean; //From Dimon ;)
const
{$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)}
urlSupport = 'http://cableproject.net/chat.php';
{$ELSE}
urlSupport = 'http://support.expertsoft.com.ua/index/index/type/question';
{$IFEND}
epsilon: Double = 0.000001;
{$if Defined(ES_GRAPH_SC)}
VersionEXE = '2.0.0';
{$else}
//28.03.2011 VersionEXE = '1.5.7 alfa'; //16.03.2011 '1.5.6';
VersionEXE = '2.2.0'; //27.12.2011 '1.5.7';
{$ifend}
{$IF Defined(SCS_RF) or Defined(SCS_PE) or Defined(SCS_SPA)}
{$IF Defined(SCS_PE)}
PROG_NEWSID = '-1';
SiteUrlNews = 'http://www.cableproject.net/';
{$ELSEIF Defined(SCS_SPA)}
PROG_NEWSID = '-1';
SiteUrlNews = 'http://www.telcocad.net/';
{$ELSE}
PROG_NEWSID = '-1';
SiteUrlNews = 'http://www.expertsoft.ru/';
{$IFEND}
{$ELSE}
{$IF Defined(TELECOM)}
PROG_NEWSID = '22';
SiteUrlNews = 'http://www.expertsoft.com.ua/';
{$ELSE}
{$if Defined(ES_GRAPH_SC)}
PROG_NEWSID = '-1';
{$else}
PROG_NEWSID = '3';
{$ifend}
SiteUrlNews = 'http://www.expertsoft.com.ua/';
{$IFEND}
{$IFEND}
// ôîðìàòû ëèñòîâ
cA0x = 1189;
cA0y = 841;
cA1x = 841;
cA1y = 594;
cA2x = 594;
cA2y = 421;
cA3x = 421;
cA3y = 297;
cA4x = 297;
cA4y = 210;
cA5x = 210;
cA5y = 148;
cA6x = 105;
cA6y = 74;
cB4x = 353;
cB4y = 250;
cB5x = 250;
cB5y = 176;
cLetterx = 279;
cLettery = 215;
cTabloidx = 431;
cTabloidy = 279;
cSCSExpert = 120;
cCADNoobAdd = 94;
cCADNoob_PE = 840+cCADNoobAdd;
cSCSNoob_PE = 240;
cCADNoob_SCS = 940+cCADNoobAdd;
cSCSNoob_SCS = 200;
cCADNoob_TEL = 890+cCADNoobAdd;
// Èíäåêñû êëàññîâ
ciOrthoLine = 01;
ciConnectorObject = 02;
ciTextMod = 03;
ciFigureGrpMod = 04;
ciFigureGrpNotMod = 05;
ciFrame = 06;
ciSCSHDimLine = 07;
ciSCSVDimLine = 08;
ciRichTextMod = 09;
ciCabinet = 10;
ciCabinetExt = 11;
ciCabinetNumber = 12;
ciPlanObject = 13;
ciPlanConnector = 14;
ciPlanTrace = 15;
ciCadNorms = 16;
ciSCSFigureGrp = 17;
ciHouse = 18;
ciApproach = 19;
ciFigureGrp = 20;
// Íîìåðà ñëîåâ
lnSubstrate = 1;
lnSCSCommon = 2;
lnArch = 8;
lnRoom = 9;
// Íàïðàâëåíèå ñäâèãà îáúåêòîâ - shift direction
sdUp = 1;
sdDown = 2;
sdLeft = 3;
sdRight = 4;
// Òèïû îáúåêòîâ ðàìêè
ftProjectName = 100;
ftListName = 200;
ftCodeName = 300;
ftIndexName = 400;
ftDeveloperName = 500;
ftCheckerName = 600;
//03.10.2012
ftMainEngineer = 700;
ftApproved = 800;
ftDesignStage = 900;
ftOrgName = 1000;
ftListDescription = 1100;
ctFrameTypeCount = 11;
ctCoordNearDelta = 0.8; //1.5; //23.04.2012 1.1;
var
GCheckAccessory: Boolean = False;
GReadOnlyMode: Boolean = False;
Newshandle : THandle;
GNowRefresh: Boolean = False; // ôëàã îáíîâëåíèÿ ÊÀÄ ïðè PCad.Refresh
GExitProg: Boolean = False; // ôëàã âûõîäà èõ ïðèëîæåíèÿ
GTraceStatus: Boolean = False; // ôëàã ñòàòóñà òðàññû (ðåæèì òðåéñà/íîðìàëüíûé)
GObjectStatus: Boolean = False; // ôëàã ñòàòóñà ÐÒ (ðåæèì òðåéñà/íîðìàëüíûé)
GIsLastShadowCleared: Boolean = False; // ôëàã áûë ëè î÷èùåí ïîñëåäíèé Shadow ïðè âîññòîíîâëåíèè òðàññû
GTraceNotMove: Boolean = False; // ôëàã áûë ëè ïåðåìåùåí ÐÒ â ðåæèìå òðåéñà
GNormalNotMove: Boolean = False; // ôëàã áûë ëè ïåðåìåùåí ÐÒ â íîðì. ðåæèìå
GIsConnMoved: Boolean = False; // ôëàã ÐÒ áûë ïåðåìåùåí
GIsMousePressed: Boolean = False; // ôëàã ëåâàÿ êíîïêà ìûøè ñåé÷àñ íàæàòà
GIsDrawShadow: Boolean = False; // ôëàã ðèñîâàíèÿ Shadow íà DragOver
GReDrawAfterRefresh: Boolean = False; // ôëàã ïåðåðèñîâàòü Shadow òðàññû ïîñëå îáíîâëåíèÿ ÊÀÄà
GIsProgress: Boolean = False; // ôëàã íàëè÷èå ïðîãðåññ-áàðà â äàííûé ìîìåíò
GMoveWithRaise: Boolean = True; // ôëàã ïåðåìåùàòü Ðò âìåñòå ñ ñ-ï
GAppMinim: Boolean = False; // ôëàã ïðèëîæåíèå ìèíèìèçèðîâàíî
GAutoDelete: Boolean = False; // ôëàã - óäàëèòü îáúåêòû áåç âîïðîñîâ
// GWasDeleteQuery: Boolean = False; // ôëàã áûë ëè âûäàí çàïðîñ íà óäàëåíèå îáúåêòîâ
GCanDeleteFigures: Boolean = False; // ôëàã óäàëÿòü ëè îáúåêòû ïî çàïðîñó
GMoveByArrow: Boolean = False; // ôëàã - ïåðåìåùåíèå êóðñîðîì íà êëàâå
GIsProgressHandling: Boolean = False; // ôëàã ïðîãðåññ-áàã ñåé÷àñ àêòèâåí (íà ýêðàíå)
GtmpIsRaise: Boolean = False; // ñîõð. ñâîéñòâà ñ-ï èëè íå ñ-ï äëÿ òåêóùåé òðàññû
GListRaiseWithErrors: Boolean = False; // ôëàã - ëèñò áûë ïîäíÿò ñ îøèáêàìè
GDisableMove: Boolean = False; // çàïðåùàòü âñå ñâÿçàííûå ïåðåìåùåíèÿ (äëÿ ñãðóïïèðîâàííûõ)
GMovedByLine: Boolean = False; // ôëàã, ÷òî ïåðåìåùåíèå èäåò ÷åðåç ëèíèþ
GMovedByOtherObject: Boolean = False; // ôëàã, ÷òî ïåðåìåùåíèå èäåò ÷åðåç äðóãîé îáúåêò
GMovedBySelf: Boolean = False; // ôëàã, ÷òî ïåðåìåùåíèå èäåò ÷åðåç ñåáÿ
GProjectChanged: Boolean = False; // â òåêóùåì ïðîåêòå áûëè èçìåíåíèÿ
GCanRefreshProperties: Boolean = True; // ìîæíî îáíîâëÿòü ñâîéñòâà íà îáðàáîò÷èêå
ShowCreateRaiseQuery: Boolean = True; // âûäàâàòü çàïðîñ íà ïîäòâåðæäåíèå ñîçäàíèÿ ì-ý ñ-ï
GOrthoStatus: Boolean = False; // ñòàòóñ îðòîãîíàëüíîñòè ïî äåôîëòó
GLastClickOrtho: Boolean = False; // ïîñëåäíèé êëèê îðòî
GNotNeedCheckRaisesBeforeClose: Boolean = False; // íå ïðîâåðÿòü ëèñò íà íàëè÷èå ì-ý ñ-ï ïåðåä çàêðûòèåì
GPreview: Boolean = False; // çàïóñê ñ ïðåâüþ, óñòàíîâèòü ôîðìàò ëèñòà ïðèíóäèòåëüíî
GCloseProg: Boolean = False;
GDefaultAngle: Integer = 90; // óãîë îðòîãîíàëüíîãî ïîâîðîòà òðàññû ïî äåôîëòó
GDefaultNum: Integer = 1; // êîë-âî ëèíèé â òðàññå ïî äåôîëòó
GClickIndex: Integer = 0; // êîë-âî êëèêîâ â ðåæèìå ñîçäàíèÿ òðàññû
GIsProgressCount: Integer = 0; // êîë-âî ñîçäàííûõ ïðîãðåññ-áàðîâ â öèêëå
GSavedScrollPosX: Integer = -1; // ñîõð. ïîçèöèÿ ñêðîëëà ïî Õ
GSavedScrollPosY: Integer = -1; // ñîõð. ïîçèöèÿ ñêðîëëà ïî Õ
GSavedZoomScale: Integer = 100; // ñîõð. ìàñøòàá ÊÀÄà
GSaveUndoCount: Integer = 1; // êîë-âî äåéñòâèé ïîñëå êîòîðîãî ñëåäóåò äåëàòü ñëåïîê äëÿ Ctrl+Z
GDefaultGap: Double = 4; // ðàññòîÿíèå ìåæäó ëèíèÿìè ó ìóëüòèëàéíà ïî äåôîëòó
GDraggedFigureZOrder: Double = -1; // âûñîòà ñîçäàâàåìîãî îáúåêòà èç ÍÁ â ðåæèìå DragOver
GCurrShadowTraceX: Double = -1; // òåêóùåå ïîëîæåíèå ïî X ëèíèè â ðåæèìå ShadowTrace
GCurrShadowTraceY: Double = -1; // òåêóùåå ïîëîæåíèå ïî Y ëèíèè â ðåæèìå ShadowTrace
GRoomHeight: Double = 2.5; // âûñîòà êîìíàòû ïî äåôîëòó
GFalseFloorHeight: Double = 0.15; // âûñîòà ôàëüø-ïîòîëêà ïî äåôîëòó
GConnHeight: Double = 0.3; // âûñîòà ÐÒ ïî äåôîëòó
GLineHeight: Double = 2.35; // âûñîòà òðàññ ïî äåôîëòó
GAddDeltaX: Double = 0; // ðàññòîÿíèå ïî X íà êîòîðîå áûë ñäâèíóò êóðñîð ïðè êëèêå íà ÐÒ (îòíèìàåòüñÿ îò deltax íà Move)
GAddDeltaY: Double = 0; // ðàññòîÿíèå ïî Y íà êîòîðîå áûë ñäâèíóò êóðñîð ïðè êëèêå íà ÐÒ (îòíèìàåòüñÿ îò deltay íà Move)
GLastSurfaceMoveX: Double = 0; // ïîñëåäíåå ïîëîæåíèå ÊÀÄà ïî Õ ïðè ïàíîðàìèðîâàíèè
GLastSurfaceMoveY: Double = 0; // ïîñëåäíåå ïîëîæåíèå ÊÀÄà ïî Y ïðè ïàíîðàìèðîâàíèè
// ïîëîæåíèå òðàññèðóåìîé ëèíèè ActualPoints[1] & ActualPoints[2]
GLastTracedLinePoints1: TDoublePoint;
GLastTracedLinePoints2: TDoublePoint;
// íà÷àëüíîå ïîëîæåíèå îáúåêòà ïåðåä òðàññèðîâàíèåì
GBeforeDragConnectorPoints: TDoublePoint; // ap äëÿ êîííåêòîðà
GBeforeDragOrthoLinesPoints1: TDoublePoint; // ap1 äëÿ òðàññû
GBeforeDragOrthoLinesPoints2: TDoublePoint; // ap2 äëÿ òðàññû
GOrthoLinePoints1: TDoublePoint; // ñîõð. òî÷åê îðòîëèíèè â Stream - ap1
GOrthoLinePoints2: TDoublePoint; // ñîõð. òî÷åê îðòîëèíèè â Stream - ap2
GConnectorPoints: TDoublePoint; // ñîõð. òî÷êè ÐÒ â Stream
GCurrMousePos: TDoublePoint; // òåêóùåå ïîëîæåíèå ìûøè íà ÊÀÄå
GMouseDownPos: TDoublePoint; // ïîëîæåíèå ìûøè íà ÊÀÄå â ìîìåíò êëèêà
GTempActualPoints: array of TDoublePoint; // ñîõð. ìàññèâ òî÷åê äëÿ ñîçäàíèÿ òðàññû
GTempDrawFigureAP: array of TDoublePoint; // ñîõð. ìàññèâ òî÷åê äëÿ DrawFigure îáúåêòà
GGlobalShiftState: TShiftState; // ñîñòîÿíèå êëàâèø Shift, Ctrl, Alt íà ÊÀÄå
GCurrentConnectorType: TConnectorType; // òåêóùèé òèï ñîçäàâàåìîãî êîííåêòîðà
SCSEngine: TSCSEngine = nil; // êëàññ, äëÿ ïîëó÷åíèÿ ÓÃÎ èç ÍÁ äëÿ ÐÒ è òðàññ
GtmpObjectFromRaisedLine: TConnectorObject = nil; // ñîõð. Îáúåêò íà îñíîâàíèè îò ñ-ï
GDeletedFromPMFigure: TFigure = nil; // óäàëåííûé èç ÏÌ îáúåêò
GPopupFigure: TFigure = nil; // òåêóùàÿ Popup ôèãóðà
GFigureSnap: TFigure = nil; // òåêóùèé îáúåêò äëÿ ïðèâÿçûâàíèÿ
GPrevFigureSnap: TFigure = nil; // ïðåäûäóùèé îáúåêò äëÿ ïðèâÿçûâàíèÿ
GFigureTraceTo: TFigure = nil; // òåêóùèé îáúåêò äëÿ ïðèâÿçûâàíèÿ â ðåæèìå òðåéñà
CheckFigure: TFigure = nil; // ôèãóðà, íàéäåííàÿ ïðè êëèêå èëè ïðè äðîïå
GPrevFigureTraceTo: TFigure = nil; // ïðåäûäóùèé îáúåêò äëÿ ïðèâÿçûâàíèÿ â ðåæèìå òðåéñà
GPropertiesObject: TFigure = nil; // òåêóùàÿ ôèãóðà äëÿ âûçîâà ñâîéñòâ
GShadowObject: TFigureGrpNotMod = nil; // Shadow äëÿ îîòîáðàæåíèÿ â ðåæèìå
GLastConnector: TConnectorObject = nil; // ïîñëåäíèé ìîäèôèöèðîâàííûé êîííåêòîð
GEndPoint: TFigure = nil; // òåêóùàÿ êîíå÷íàÿ òî÷êà
GRefreshCad: TPowerCad = nil; // ÊÀÄ äëÿ âûçîâà Refresh
GCadForm: TF_CAD = nil; // óêàçàòåëü íà òåêóùèé ÊÀÄ
GLastCadForm: TF_CAD = nil; // óêàçàòåëü íà ïîñëåäíèé ÊÀÄ
GListWithEndPoint: TF_CAD = nil; // óêàçàòåëü íà ÊÀÄ íà êîòîðîì îáîçíà÷åíà êîíå÷íàÿ òî÷êà
GSaveNavigatorFigures: TList = nil; // ëèñò ñ ñîõð. ôèãóð Íàâèãàòîðà
GTempJoinedOrtholinesList: TList = nil; // ëèñò ñ ñîõð. ïðèâÿçàííûìè îðëèíèÿìè (äëÿ ðåæèìà òðåéñà)
GTempJoinedConnectorsList: TList = nil; // ëèñò ñ ñîõð. ïðèâÿçàííûìè êîííåêòîðàìè (äëÿ ðåæèìà òðåéñà)
GTempJoinedLinesConnectors: TList = nil; // ëèñò ñ ñîõð. ïðèâÿçàííûìè êîííåêòîðàìè ÷åðåç ïðèâÿçàííóþ ëèíèþ (äëÿ ðåæèìà òðåéñà)
GSnapFiguresList: TList = nil; // ñîõð. ñïèñîê ïðèâÿçàííûõ îáúåêòîâ â ðåæèìå ñîçäàíèÿ ëèíèè
GUndoList: TList = nil; // Undo ëèñò äëÿ ïðîåêòà
GRedoList: TList = nil; // Redo ëèñò äëÿ ïðîåêòà
GAutoTraceCount: integer;
GMyLog: TStringList;
Gt_matrix: boolean = false;
GAutoAddCableAfterDragDrop: Boolean = false;
GCableStartDrag: Boolean = False;
GCurrentRoom3DView: TSCSComponent = nil;
GSaved3DModelExist: Boolean = True;
// ***************************************************************************
GLiteVersion: Boolean = True;
GUseLiteFunctional: Boolean = True;
GAllowConvertInterfToUniversal: Boolean = False;
GIfMasterUsed: Boolean = False;
GSCStream: TMemoryStream;
// 2011-05-10
G3DModelForProject: Boolean = False;
{$IF Defined(ES_GRAPH_SC)}
GUseArhOnlyMode: Boolean = True;
{$ELSE}
GUseArhOnlyMode: Boolean = False;
{$IFEND}
// ***************************************************************************
GAllowExternalListCoordZ: Boolean = true; //22.08.2012 false - ïîçâîëÿòü èñïîëüçîâàòü ðàçíûå âûñîòû îáúåêòîâ íà ðàñïðåäåëèòåëüíîì ëèñòå
GRaizeDownKoeff: Double = 4;
//************* Hot Keys *********************
hkCtrlN,
hkCtrlL,
hkCtrlO,
hkCtrlF4,
hkCtrlS,
hkCtrlP,
hkCtrlE,
hkF1,
hkCtrlM,
hkCtrlB,
hkCtrlG,
hkADD,
hkSUBTRACT,
hkCtrlF1,
hkCtrlD,
hkCtrlDIVIDE,
hkCtrlSUBTRACT,
hkCtrlDECIMAL,
hkCtrl4,
hkCtrlShiftO,
hkCtrlShiftS,
hkCtrlShiftN: word;
// Çàðåãèñòðèðîâàòü ñ öåëüþ áëîêèðîâêè ! (íà ÊÀÄå)
hkCtrlZ,
hkCtrlY,
hkCtrlX,
hkCtrlC,
hkCtrlV: word;
//********************************************
GTestCopyMode: TCopyMode = cmSrcCopy;
implementation
uses USCS_Main, Menus, U_main, U_MasterNewList, U_MasterNewListLite, U_AutoTraceType, U_Layers, FPlan, U_SCSObjectsProp,
cxMemo, U_ChooseComponTypes, U_EndPoints, U_TrunkSCS, U_Constants, U_ChooseDesignBoxParams,
U_AutoTraceConnectOrder, U_Protection, cxCheckBox, U_PrintLists, U_ArchCommon, U_ImportDXF, U_ProtectionCommon,
U_InputRadio, U_BaseConstants,
cxSpinEdit, Printers, PCPanel, U_InputMark, U_PEAutotraceDialog;
function RoundN(Num: Extended; Dig: integer): Extended;//Extended;
var
Fakt: Extended;
Vrem: Extended;
pw: Extended;
begin
// SetPrecisionMode(pmExtended);
// Set8087CW(Default8087CW);
if false then
begin
if Dig < 5 then
begin
Num := Num * 1000000;
Num := Trunc(Num)+0.0000000; // trunc returns Int64, so we must made extended
Num := Num / 1000000;
end;
end;
pw := Power(10, Dig);
try // ïðè íè÷òîæíî ìàëûõ çíà÷åíèÿõ òèïà 1Å+4000 âîçíèêàåò îøèáêà
Fakt := Frac(Num);
except
Fakt := 0;
end;
Fakt := pw * Fakt;
try // ïðè íè÷òîæíî ìàëûõ çíà÷åíèÿõ òèïà 1Å+4000 âîçíèêàåò îøèáêà
Vrem := Frac(Fakt);
except
Vrem := 0;
end;
Fakt := Int(Fakt);
if (Vrem - 0.5) >= -epsilon then
Fakt := Fakt + 1
else if (Vrem + 0.5) <= -epsilon then
Fakt := Fakt - 1;
try
Result := Int(Num) + Fakt/pw;
except
Result := Int(Num);
end;
end;
Function CheckAssignedPCAD(aPcad: TPCDrawing): Boolean;
begin
Result := false;
if (aPcad.Owner <> nil) and (aPcad.Owner is TF_Cad) and( TF_Cad(aPcad.Owner).FCheckedFigures <> nil) then
begin
Result := True;
end;
end;
// êàðòèíêà íà êîíåêòîð
function GetConnectorImg(aOT: TConnectorType): TFigureGrpMod;
begin
Result := nil;
try
Result := SCSEngine.GetConnectorImg(aOT);
except
on E: Exception do addExceptionToLogEx('U_Common.GetConnectorImg', E.Message);
end;
end;
function GetOrthoLineImg(aOT: TOrthoLineType): TFigureGrpMod;
begin
Result := nil;
try
Result := SCSEngine.GetOrthoLineImg(aOT);
except
on E: Exception do addExceptionToLogEx('U_Common.GetOrthoLineImg', E.Message);
end;
end;
// ïðîöåäóðà äëÿ óñòàíîâêè ïàðàìåòðîâ íîâîãî CAD ïî óìîë÷àíèþ
procedure SetDefaultPageParams;
begin
try
//// çàäàòü ïàðàìåòðû ïî óìîë÷àíèþ äëÿ CAD
FSCS_Main.a100.Execute; // âèä - 100%
FSCS_Main.apsSolid.Execute; // Ñòèëü ëèíèè - ñïëîøíàÿ
FSCS_Main.aPenw1.Execute; // Øèðèíà ëèíèè - 1
FSCS_Main.arsNone.Execute; // Ñòèëü ñòðåëêè - íåò
FSCS_Main.absClear.Execute; // Ñòèëü çàëèâêè - î÷èñòêà
FSCS_Main.aDEFAULT_CHARSET.Execute; // Íàáîð ñèìâîëîâ - DEFAULT
FSCS_Main.aTextFont.Execute; // Øðèôò - MS Sans Serif
FSCS_Main.aTextSize.Execute; // Ðàçìåð øðèôòà - 8
FSCS_Main.aLineGrid.Execute; // Òèï ñåòêè - ëèíåéíàÿ
FSCS_Main.aAngularNone.Execute; // Íàïðàâëÿþùèå ïîä óãëîì - íåò
// FSCS_Main.aMetric.Execute; // Ñèñòåìà ëèíåéêè - ìåòðîâàÿ
FSCS_Main.aWorldMode.Execute; // Ðåæèì ëèíåéêè - ðåàëüíàÿ
FSCS_Main.aSetDefaultColors.Execute; // Óñòàíîâêà öâåòà äëÿ:
// Öâåò ëèíèè - ÷åðíûé
// Öâåò çàëèâêè - ÷åðíûé
// Öâåò òåêñòà - ÷åðíûé
// Öâåò ñåòêè - ñåðûé
// Öâåò íàïðàâëÿþùèõ - çåëåíûé
// Öâåò ôîíà - ñåðûé
// Öâåò ëèñòà - áåëûé
except
on E: Exception do addExceptionToLogEx('U_Common.SetDefaultPageParams', E.Message);
end;
end;
Procedure ReturnListParams;
var
SavedProjectChanged: Boolean;
begin
SavedProjectChanged := GProjectChanged;
try
FSCS_Main.aA0.Checked := False;
FSCS_Main.aA1.Checked := False;
FSCS_Main.aA2.Checked := False;
FSCS_Main.aA3.Checked := False;
FSCS_Main.aA4.Checked := False;
FSCS_Main.aA5.Checked := False;
FSCS_Main.aA6.Checked := False;
FSCS_Main.aB4.Checked := False;
FSCS_Main.aB5.Checked := False;
FSCS_Main.aTabloid.Checked := False;
FSCS_Main.aLetter.Checked := False;
FSCS_Main.aCustom.Checked := False;
FSCS_Main.aPortrait.Checked := False;
FSCS_Main.aLandscape.Checked := False;
// Ðàçìåð ñòðàíèöû
if GCadForm.PCad.PageLayout = plA0 then
FSCS_Main.aA0.Checked := True;
if GCadForm.PCad.PageLayout = plA1 then
FSCS_Main.aA1.Checked := True;
if GCadForm.PCad.PageLayout = plA2 then
FSCS_Main.aA2.Checked := True;
if GCadForm.PCad.PageLayout = plA3 then
FSCS_Main.aA3.Checked := True;
if GCadForm.PCad.PageLayout = plA4 then
FSCS_Main.aA4.Checked := True;
if GCadForm.PCad.PageLayout = plA5 then
FSCS_Main.aA5.Checked := True;
if GCadForm.PCad.PageLayout = plA6 then
FSCS_Main.aA6.Checked := True;
if GCadForm.PCad.PageLayout = plB4 then
FSCS_Main.aB4.Checked := True;
if GCadForm.PCad.PageLayout = plB5 then
FSCS_Main.aB5.Checked := True;
if GCadForm.PCad.PageLayout = plTabloid then
FSCS_Main.aTabloid.Checked := True;
if GCadForm.PCad.PageLayout = plLetter then
FSCS_Main.aLetter.Checked := True;
if GCadForm.PCad.PageLayout = plCustom then
FSCS_Main.aCustom.Checked := True;
// Îðèåíòàöèÿ ñòðàíèöû
if GCadForm.PCad.PageOrient = PCTypesUtils.poPortrait then
FSCS_Main.aPortrait.Checked := True;
if GCadForm.PCad.PageOrient = PCTypesUtils.poLandscape then
FSCS_Main.aLandscape.Checked := True;
if FSCS_Main.ActiveMDIChild <> nil then
begin
// Ñèñòåìà ëèíåéêè
if GCadForm.PCad.RulerSystem = rsMetric then
FSCS_Main.aMetric.Execute;
if GCadForm.PCad.RulerSystem = rsWhitworth then
FSCS_Main.aWitworth.Execute;
// Ðåæèì ëèíåéêè
if GCadForm.PCad.RulerMode = rmPage then
FSCS_Main.aPageMode.Execute;
if GCadForm.PCad.RulerMode = rmWorld then
FSCS_Main.aWorldMode.Execute;
// Òèï ñåòêè
if GCadForm.PCad.GridType = grtLine then
FSCS_Main.aLineGrid.Execute;
if GCadForm.PCad.GridType = grtCross then
FSCS_Main.aCrossGrid.Execute;
if GCadForm.PCad.GridType = grtPoint then
FSCS_Main.aPointGrid.Execute;
// Íàïðàâëÿþùèå ïîä óãëîì
if GCadForm.PCad.GuideTrace = gtNone then
FSCS_Main.aAngularNone.Execute;
if GCadForm.PCad.GuideTrace = gtThirty then
FSCS_Main.aAngular30.Execute;
if GCadForm.PCad.GuideTrace = gtFortyfive then
FSCS_Main.aAngular45.Execute;
if GCadForm.PCad.GuideTrace = gtSixty then
FSCS_Main.aAngular60.Execute;
if GCadForm.PCad.GuideTrace = gtNinty then
FSCS_Main.aAngular90.Execute;
end;
// Ïåðåïîäíÿòü ôëàãè
// ïîêàçûâàòü ëèíåéêè
FSCS_Main.aShowRuler.Checked := GCadForm.PCad.RulerVisible;
GCadForm.tbShowRuler.Down := GCadForm.PCad.RulerVisible;
// ïîêàçûâàòü ñåòêó
FSCS_Main.aShowGrid.Checked := GCadForm.PCad.Grids;
GCadForm.tbShowGrid.Down := GCadForm.PCad.Grids;
// ïîêàçûâàòü öåíòð. íàïðàâëÿþùèå
FSCS_Main.aShowCenterGuides.Checked := GCadForm.PCad.CenterGuide;
// ïîêàçûâàòü íàïðàâëÿþùèå
FSCS_Main.aShowGuideLines.Checked := GCadForm.PCad.GuidesVisible;
GCadForm.tbShowGuides.Down := GCadForm.PCad.GuidesVisible;
// ïðèâÿçêà ê ñåòêå
FSCS_Main.aSnaptoGrid.Checked := GCadForm.PCad.SnapToGrids;
GCadForm.tbSnapGrid.Down := GCadForm.PCad.SnapToGrids;
GCadForm.LastSnapGridStatus := GCadForm.PCad.SnapToGrids;
// ïðèâÿçêà ê íàïðàâëÿþùèì
FSCS_Main.aSnaptoGuides.Checked := GCadForm.PCad.SnapToGuides;
GCadForm.tbSnapGuides.Down := GCadForm.PCad.SnapToGuides;
// ïðèâÿçêà ê áëèæ. îáúåêòó
FSCS_Main.aSnaptoNearObject.Checked := GCadForm.PCad.SnapToNearPoint;
GCadForm.tbSnapNearObject.Down := GCadForm.PCad.SnapToNearPoint;
// Ïåðåïîäíÿòü ôëàãè !!!
FSCS_Main.aAutoSelectTrace.Checked := GCadForm.FAutoSelectTrace;
// GCadForm.tbAutoSelectTrace.Down := GCadForm.FAutoSelectTrace;
FSCS_Main.aShowTracesLengthLimit.Checked := GCadForm.FShowTracesLengthLimit;
GCadForm.tbShowTracesLengthLimit.Down := GCadForm.FShowTracesLengthLimit;
FSCS_Main.aShowConnFullness.Checked := GCadForm.FShowConnFullness;
GCadForm.tbShowConnFullness.Down := GCadForm.FShowConnFullness;
FSCS_Main.aShowCableFullness.Checked := GCadForm.FShowCableFullness;
GCadForm.tbShowCableFullness.Down := GCadForm.FShowCableFullness;
FSCS_Main.aShowCableChannelFullness.Checked := GCadForm.FShowCableChannelFullness;
GCadForm.tbShowCableChannelFullness.Down := GCadForm.FShowCableChannelFullness;
FSCS_Main.aNoMoveConnectedObjects.Checked := GCadForm.FNoMoveConnectedObjects;
GCadForm.tbNoMoveConnectedObjects.Down := GCadForm.FNoMoveConnectedObjects;
except
on E: Exception do addExceptionToLogEx('U_Common.ReturnListParams', E.Message);
end;
GProjectChanged := SavedProjectChanged;
end;
Function GetComponentFromNormBase(X, Y: Double; NB_Component: TSCSComponent; ASnapFigure: TFigure; CompStateType: TCompStateType): TFigure;
var
PointObject: TConnectorObject;
ClearObject1: TConnectorObject;
ClearObject2: TConnectorObject;
LineObject: TOrthoLine;
LineLength: Double;
PropCount: integer;
LHandle: integer;
Prop: PProperty;
GetCoords: TDoublePoint;
Z: Double;
//Tolik
vx, vy, vz, xx1, xx2, yy1, yy2, zz1, zz2, TempZ : Double;
SprComponentType: TNBComponentType;
// âû÷èñëÿåò Z - êîîðäèíàòó "ïàäåíèÿ" òî÷å÷íîãî êîìïîíåíòà íà íàêëîííóþ ëèíèþ,
// åñëè êîîðäèíàòû X, Y - èçâåñòíû
Function GetCoordZ(ASnapFigure: TFigure; CoordX, CoordY: Double): Double;
Var
vx, vy, vz, xx1, xx2, yy1, yy2, zz1, zz2, TempZ : Double;
Begin
Result := 0;
//ïåðâàÿ òî÷êà ïðÿìîé
xx1 := RounDX(TOrthoLine(ASnapFigure).JoinConnector1.ActualPoints[1].x,2);
yy1 := RounDX(TOrthoLine(ASnapFigure).JoinConnector1.ActualPoints[1].y,2);
zz1 := RounDX(TConnectorObject(TOrthoLine(ASnapFigure).JoinConnector1).ActualZOrder[1],2);
//âòîðàÿ òî÷êà ïðÿìîé
xx2 := RounDX(TOrthoLine(ASnapFigure).JoinConnector2.ActualPoints[1].x,2);
yy2 := RounDX(TOrthoLine(ASnapFigure).JoinConnector2.ActualPoints[1].y,2);
zz2 := RounDX(TConnectorObject(TOrthoLine(ASnapFigure).JoinConnector2).ActualZOrder[1],2);
// íàïðàâëÿþùèé âåêòîð äëÿ ïðÿìîé (êîîðäèíàòû)
vx := xx2 - xx1;
vy := yy2 - yy1;
vz := zz2 - zz1;
if (vx <> 0) then
begin
Result := Roundx(((CoordX - xx1)/vx)*vz + zz1, 2);
end
else
begin
if (vy <> 0) then
Result := RoundX(((CoordY - yy1)/vy)*vz + zz1, 2);
end;
End;
//
begin
Result := nil;
try
//29.06.2010 GCadForm.CurrentLayer := 2;
GCadForm.CurrentLayer := GetCADLayerNumByComponIsLine(NB_Component.IsLine);
LHandle := GCadForm.PCad.GetLayerHandle(GCadForm.PCad.ActiveLayer);
Result := nil;
if NB_Component <> Nil then
begin
// åñëè òî÷å÷íûé îáüåêò (êîííåêòîð)
if NB_Component.IsLine = 0 then
begin
if CheckFigureByClassName(ASnapFigure, cTConnectorObject) and (TConnectorObject(ASnapFigure).ConnectorType <> ct_Clear) then
begin
Result := nil;
end
else
begin
GCurrentConnectorType := ct_NB;
if (ASnapFigure <> nil) and CheckFigureByClassName(ASnapFigure, cTConnectorObject) then
begin
X := TConnectorObject(ASnapFigure).ActualPoints[1].x;
Y := TConnectorObject(ASnapFigure).ActualPoints[1].y;
end
else
if ASnapFigure = Nil then
begin
//if GCadForm.PCad.SnapToGrids then
// ïðèâÿçêà ê íàïðàâëÿþùèì
if (GCadForm.PCad.SnapToGuides)or(GCadForm.PCad.SnapToGrids) then
begin
GetCoords := GetCoordsWithSnapToGrid(X, Y);
X := GetCoords.x;
Y := GetCoords.y;
end;
end;
//Tolik
// if Z = 0 then
// Z := GCadForm.FConnHeight;
Z := 0;
TempZ := 0;
if NB_Component.GetPropertyBySysName(pnHeightOfPlacing) <> nil then
Z := NB_Component.GetPropertyValueAsFloat(pnHeightOfPlacing);
// âûñîòà ðàçìåùåíèÿ íå çàäàíà
if NB_Component.GetPropertyBySysName(pnHeightOfPlacing) = nil then
begin
// àâòîïðèìåíåíèå âûñîò âêëþ÷åíî
if F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.UseComponTypeHeights then
begin
SprComponentType := nil;
SprComponentType := F_ProjMan.GSCSBase.CurrProject.CurrList.Spravochnik.GetComponentTypeByGUID(NB_Component.GUIDComponentType);
if SprComponentType <> nil then
begin
// åñëè çàäàíà âûñîòà ðàçìåùåíèÿ îáúåêòîâ äàííîãî òèïà, òî áåðåì âûñîòó òàì
if SprComponentType.ComponentType.CoordZ <> -1 then
begin
Z := SprComponentType.ComponentType.CoordZ;
end
else
// åñëè íå çàäàíà âûñîòà ðàçìåùåíèÿ îáúåêòîâ äàííîãî òèïà, òî ðàçìåùàåì íà âûñîòå òî÷å÷íûõ ïî ëèñòó
begin
Z := GCadForm.FConnHeight;
end;
end;
TempZ := 0;
end
// àâòîïðèìåíåíèå âûñîò âûêëþ÷åíî
else
begin
// íà ïóñòîå ìåñòî
if ASnapFigure = nil then
begin
z:= 0;
end
else
begin
// íà ëèíèþ
if ASnapFigure.ClassName = 'TOrthoLine' then
begin
// åñëè ëèíèÿ íå íàêëîííàÿ (âûñîòû íà÷àëà è êîíöà ñõîäÿòñÿ)
if TConnectorObject(TOrthoLine(ASnapFigure).JoinConnector1).ActualzOrder[1] =
TConnectorObject(TOrthoLine(ASnapFigure).JoinConnector2).ActualzOrder[1] then
begin
Z := Tortholine(ASnapFigure).ActualZOrder[1];
end
else
// ëèíèÿ íàêëîííàÿ, âû÷èñëÿåì âûñîòó
begin
Z := GetCoordZ(ASnapFigure, X, Y);
end;
end;
// íà êîííåêòîð
if ASnapFigure.ClassName = 'TConnectorObject' then
begin
Z := TConnectorObject(ASnapFigure).ActualZOrder[1];
end;
TempZ := 999;
end;
end;
end;
// âûñîòà ðàçìåùåíèÿ çàäàíà
if NB_Component.GetPropertyBySysName(pnHeightOfPlacing) <> nil then
begin
if z = 999 then
begin
// íà ïóñòîå ìåñòî
if ASnapFigure = nil then
begin
// íà âûñîòó ëèíåéíûõ ïî ëèñòó
Z := GCadForm.FLineHeight;
end
else
begin
// íà ëèíèþ
if ASnapFigure.ClassName = 'TOrthoLine' then
begin
// åñëè ëèíèÿ íå íàêëîííàÿ (âûñîòû íà÷àëà è êîíöà ñõîäÿòñÿ)
if TConnectorObject(TOrthoLine(ASnapFigure).JoinConnector1).ActualzOrder[1] =
TConnectorObject(TOrthoLine(ASnapFigure).JoinConnector2).ActualzOrder[1] then
begin
Z := Tortholine(ASnapFigure).ActualZOrder[1];
end
else
// ëèíèÿ íàêëîííàÿ, âû÷èñëÿåì âûñîòó
begin
Z := GetCoordZ(ASnapFigure, X, Y);
end;
end;
// íà êîííåêòîð
if ASnapFigure.ClassName = 'TConnectorObject' then
begin
Z := TConnectorObject(ASnapFigure).ActualZOrder[1];
end;
end;
TempZ := 999;
end
else
TempZ := 0;
end;
PointObject := TConnectorObject.Create(X, Y, Z, LHandle, mydsNormal, GCadForm.PCad);
//Tolik
// åñëè Z = 999 èëè íå çàäàíà âûñîòà ðàçìåùåíèÿ - íóæíî áóäåò ïîñàäèòü îáúåêò íà òðàññó,
// íå ñîçäàâàÿ ñïóñêà-ïîäúåìà, ïîòîìó çàþçàåì ñâîéñòâî ðàäèóñà, äëÿ ïåðåäà÷è ïàðàìåòðà ÷òîáû äÿëüøå åãî "óâèäåòü"
if TempZ = 999 then
PointObject.Radius := 999 + 11000000;
if ASnapFigure <> nil then
begin
if ASnapFigure.ClassName = 'TOrthoLine' then
begin
if TOrthoLine(ASnapFigure).ActualZOrder[1] <> TOrthoLine(ASnapFigure).ActualZOrder[2] then
{ PointObject.Urc := -1;}
end;
end;
PointObject.ConnectorType := GCurrentConnectorType;
GCadForm.PCad.AddCustomFigure (GLN(LHandle), PointObject, False);
Result := TFigure(PointObject);
end;
end
else
// åñëè ëèíåéíûé îáüåêò (îðòîëèíèÿ)
if NB_Component.IsLine = 1 then
//29.06.2010 if NB_Component.IsLine <> 0 then
begin
// ÍÅ ñîçäàâàòü ëèíèþ òàê êàê îíà âëèâàåòüñÿ â òðàññó!!!
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetComponentFromNormBase', E.Message);
end;
end;
Function FindAutoSnapObject(X, Y: Double; NB_Component: TSCSComponent): TFigure;
var
FindFigure: TFigure;
RaiseConn: TConnectorObject;
begin
Result := Nil;
try
//07.06.2010 GCadForm.CurrentLayer := 2;
GCadForm.CurrentLayer := GetCADLayerNumByComponIsLine(NB_Component.IsLine);
//Result := Nil;
// òÿíåòüñÿ êîíåêòîð
if NB_Component.IsLine = 0 then
begin
try
FindFigure := CheckBySCSObjects(X, Y);
except
FindFigure := nil;
end;
if FindFigure <> Nil then
begin
if CheckFigureByClassName(FindFigure, cTConnectorObject) then
begin
// Check FindFigure On Connector
if (TConnectorObject(FindFigure).ConnectorType = ct_Clear) and (TConnectorObject(FindFigure).JoinedConnectorsList.Count > 0) then
Result := nil
else
Result := FindFigure;
if (TConnectorObject(FindFigure).FConnRaiseType = crt_BetweenFloorUp) or
(TConnectorObject(FindFigure).FConnRaiseType = crt_BetweenFloorDown) or
(TConnectorObject(FindFigure).FConnRaiseType = crt_TrunkUp) or
(TConnectorObject(FindFigure).FConnRaiseType = crt_TrunkDown) then
Result := Nil;
if not GCadForm.FShowRaise then
if TConnectorObject(FindFigure).FConnRaiseType = crt_OnFloor then
Result := Nil;
end
else if CheckFigureByClassName(FindFigure, cTOrthoLine) then
begin
if not TOrthoLine(FindFigure).FIsRaiseUpDown then
begin
if not TOrthoLine(FindFigure).FConnectingLine then
Result := FindFigure
else
Result := Nil;
end
else
Result := Nil;
end;
end;
end;
// òÿíåòüñÿ îðòîëèíèÿ
if NB_Component.IsLine = 1 then
begin
try
FindFigure := CheckBySCSObjects(X, Y);
except
FindFigure := nil;
end;
if FindFigure <> Nil then
begin
if CheckFigureByClassName(FindFigure, cTOrthoLine) then
begin
if GCadForm.FPutCableOnTrace then
Result := FindFigure
else
Result := nil;
end
else if CheckFigureByClassName(FindFigure, cTConnectorObject) then
begin
if (TConnectorObject(FindFigure).ConnectorType = ct_Clear) and (TConnectorObject(FindFigure).JoinedConnectorsList.Count > 0) then
Result := nil
else
Result := FindFigure;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.FindAutoSnapObject', E.Message);
end;
end;
// ÓÑÒÀÍÎÂÊÀ ÍÎÂÎÃÎ ÈÌÅÍÈ ÎÁÜÅÊÒÀ Â CAD-e
Procedure SetNewObjectNameInCad(AID_List, AID_Figure: Integer; AOldObjName, ANewObjName: String);
var
i: integer;
vList: TF_CAD;
CadFigure: TFigure;
SavedCadForm: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
CadFigure := GetFigureByID(vList, AID_Figure);
if CadFigure <> nil then
begin
CadFigure.Name := ANewObjName;
if CheckFigureByClassName(CadFigure, cTConnectorObject) then
begin
if not TConnectorObject(CadFigure).FIsNameChanged then
begin
SavedCadForm := GCadForm;
GCadForm := vList;
SetConnNameInCaptionOnCAD(TConnectorObject(CadFigure));
GCadForm := SavedCadForm;
end;
RefreshCAD(vList.PCad);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetNewObjectNameInCad', E.Message);
end;
end;
// ÓÄÀËÈÒÜ ÎÁÜÅÊÒ ÈÇ CAD (ÏÐÈ ÓÄÀËÅÍÈÈ ÅÃÎ ÈÇ ÌÏ)
Procedure DeleteObjectFromCad(AID_List, AID_Figure: Integer; AObjName: String);
var
FList: TF_CAD;
i: integer;
DelFigure: TFigure;
SCSFigureGrp: TSCSFigureGrp;
SavedCadList: TF_CAD;
begin
try
FList := GetListByID(AID_List);
if FList <> nil then
begin
DelFigure := GetFigureByID(FList, AID_Figure);
// íà ÊÀÄå
if DelFigure <> nil then
begin
SavedCadList := GCadForm;
GCadForm := FList;
GDeletedFromPMFigure := DelFigure;
if CheckFigureByClassName(DelFigure, cTConnectorObject) then
TConnectorObject(DelFigure).Delete(True)
else if CheckFigureByClassName(DelFigure, cTOrthoLine) then
TOrthoLine(DelFigure).Delete
else if CheckFigureByClassName(DelFigure, cTHouse) then
THouse(DelFigure).Delete
else if CheckFigureByClassName(DelFigure, cTCabinet) then
TCabinet(DelFigure).Delete
else if CheckFigureByClassName(DelFigure, cTCabinetExt) then
TCabinetExt(DelFigure).Delete;
GDeletedFromPMFigure := Nil;
RefreshCAD(FList.PCad);
GCadForm := SavedCadList;
end
else
// â ãðóïïå
begin
SCSFigureGrp := GetSCSFigureGrp(FList, AID_Figure);
if SCSFigureGrp <> nil then
begin
DelFigure := GetFigureByIDInSCSFigureGrp(SCSFigureGrp, AID_Figure);
if DelFigure <> nil then
begin
SavedCadList := GCadForm;
GCadForm := FList;
GDeletedFromPMFigure := DelFigure;
DeleteObjectFromSCSFigureGrp(SCSFigureGrp, DelFigure);
GCadForm := SavedCadList;
end
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.DeleteObjectFromCad', E.Message);
end;
end;
Procedure DeleteObjectFromSCSFigureGrp(ASCSFigureGrp: TSCSFigureGrp; AObjects: TFigure);
var
i: integer;
GrpList: TList;
begin
try
// ðàçãðóïïèðîâàòü, ÷òîáû óäàëèòü
GrpList := TList.Create;
for i := 0 to ASCSFigureGrp.InFigures.Count - 1 do
GrpList.Add(TFigure(ASCSFigureGrp.InFigures[i]));
ASCSFigureGrp.UnGroup;
GCadForm.PCad.Figures.Remove(ASCSFigureGrp);
RefreshCAD(GCadForm.PCad);
//
if CheckFigureByClassName(AObjects, cTConnectorObject) then
TConnectorObject(AObjects).Delete(True)
else if CheckFigureByClassName(AObjects, cTOrthoLine) then
TOrthoLine(AObjects).Delete;
GDeletedFromPMFigure := Nil;
RefreshCAD(GCadForm.PCad);
// ñãðóïïèðîâàòü íàçàä
SCSGroupObjects(GrpList);
FreeAndNil(GrpList);
except
on E: Exception do addExceptionToLogEx('U_Common.DeleteObjectFromSCSFigureGrp', E.Message);
end;
end;
// ÎÒÊÐÛÒÛÉ ÎÁÜÅÊÒ Â ÌÏ ÂÛÄÅËÈÒÜ ÍÀ CAD-å
Procedure SelectObjectInCAD(AID_List, AID_Figure: Integer; AObjName: String);
var
i: integer;
LHandle: Integer;
ActLayer: Integer;
vList: TF_CAD;
CADFigure: TFigure;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
vList.PCad.DeselectAll(0);
CADFigure := GetFigureByID(vList, AID_Figure);
if CADFigure <> nil then
begin
if (not CADFigure.LockSelect) and (vList.PCad.ActiveLayer = 2) then
begin
GCanRefreshProperties := True;
if vList.CurrentLayer <> 2 then
vList.CurrentLayer := 2;
CADFigure.Select;
RefreshCAD(vList.PCad);
vList.SetZoomScale(vList.PCad.ZoomScale + 0);
RefreshCAD(vList.PCad);
//GetSCSComponByCADObj(CADFigure);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SelectObjectInCAD', E.Message);
end;
end;
procedure FigureBringToFront(AFigure: TFigure);
var
CurrIndex: integer;
begin
if (AFigure.Owner <> nil) and (AFigure.Owner is TPCDrawing) then
begin
CurrIndex := TPCDrawing(AFigure.Owner).Figures.IndexOf(AFigure);
if CurrIndex <> -1 then
TPCDrawing(AFigure.Owner).Figures.Move(CurrIndex, TPCDrawing(AFigure.Owner).Figures.Count-1);
end;
end;
procedure FigureSendToBack(AFigure: TFigure);
var
CurrIndex: integer;
begin
if (AFigure.Owner <> nil) and (AFigure.Owner is TPCDrawing) then
begin
CurrIndex := TPCDrawing(AFigure.Owner).Figures.IndexOf(AFigure);
if CurrIndex <> -1 then
TPCDrawing(AFigure.Owner).Figures.Move(CurrIndex, 0);
end;
end;
procedure SetConnObjectSelectHightPriority(AFigure: TConnectorObject);
begin
if AFigure.FBlockGUID = '' then
FigureBringToFront(AFigure);
end;
Procedure SelectHouseInCAD(AID_List, AID_Figure: Integer);
var
i: integer;
LHandle: Integer;
ActLayer: Integer;
vList: TF_CAD;
House: TFigure;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
vList.PCad.DeselectAll(0);
House := GetHouseByID(vList, AID_Figure);
if House <> nil then
begin
if (not House.LockSelect) and (vList.PCad.ActiveLayer = 2) then
begin
GCanRefreshProperties := True;
if vList.CurrentLayer <> 2 then
vList.CurrentLayer := 2;
House.Select;
RefreshCAD(vList.PCad);
vList.SetZoomScale(vList.PCad.ZoomScale + 0);
RefreshCAD(vList.PCad);
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.SelectHouseInCAD', E.Message);
end;
end;
Procedure SelectApproachInCAD(aListID, aHouseID, AComponID: Integer);
var
i: integer;
LHandle: Integer;
ActLayer: Integer;
vList: TF_CAD;
House: THouse;
Approach: TConnectorObject;
begin
try
vList := GetListByID(aListID);
if vList <> nil then
begin
vList.PCad.DeselectAll(0);
Approach := GetApproachByComponID(vList, AComponID);
if Approach <> nil then
begin
if (not Approach.LockSelect) and (vList.PCad.ActiveLayer = 2) then
begin
GCanRefreshProperties := True;
if vList.CurrentLayer <> 2 then
vList.CurrentLayer := 2;
Approach.Select;
RefreshCAD(vList.PCad);
vList.SetZoomScale(vList.PCad.ZoomScale + 0);
RefreshCAD(vList.PCad);
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.SelectApproachInCAD', E.Message);
end;
end;
// ÏÐÈ ÏÅÐÅÊËÞ×ÅÍÈÈ ËÈÑÒÀ  ÌÏ ÏÅÐÅÊËÞ×ÈÒÜ ÅÃÎ ÍÀ CAD-å
Procedure SwitchListInCAD(AID_List: Integer; const ListName: String);
var
i: integer;
OldList: TF_CAD;
OldListAutoRefresh: Boolean;
vList: TF_CAD;
vListAutoRefresh: Boolean;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
OldList := nil;
if GCadForm <> vList then
OldList := GCadForm;
//vList.DisableAlign;
//vList.PCad.DisableAlign;
vListAutoRefresh := vList.PCad.AutoRefresh;
vList.PCad.AutoRefresh := false;
vList.PCad.Locked := true;
vList.PCad.BeginUpdate;
if OldList <> nil then
begin
OldList.PCad.BeginUpdate;
OldListAutoRefresh := OldList.PCad.AutoRefresh;
OldList.PCad.AutoRefresh := false;
OldList.PCad.Locked := true;
end;
try
vList.BringToFront;
finally
//vList.PCad.EnableAlign;
vList.PCad.Locked := false;
vList.PCad.AutoRefresh := vListAutoRefresh;
//vList.EnableAlign;
vList.PCad.EndUpdate;
if OldList <> nil then
begin
OldList.PCad.Locked := false;
OldList.PCad.EndUpdate(false);
OldList.PCad.AutoRefresh := OldListAutoRefresh;
end;
vList.OnResize(vList);
end;
if vList.WindowState <> wsMaximized then
vList.WindowState := wsMaximized;
//vList.PCad.ResetRegions;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SwitchListInCAD', E.Message);
end;
end;
// ÏÐÈ ÏÅÐÅÈÌÅÍÎÂÀÍÈÈ ËÈÑÒÀ Â ÌÏ ÏÅÐÅÈÌÅÍÎÂÀÒÜ ÅÃÎ ÍÀ CAD-å
Procedure RenameListInCAD(AID_List: Integer; const OldListName, NewListName: String; AOldListParams: PListParams;
ARenameOnFrame: Boolean=true);
var
i, j: integer;
GetTag: integer;
vList: TF_CAD;
// 2011-05-10
fullname: string;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
// èçìåíèòü íàçâàíèå ñàìîãî ëèñòà
// 2011-05-10
fullname := NewListName; //02.04.2013 AOldListParams^.Name + ' ' + IntToStr(AOldListParams^.MarkID);
vList.FCADListName := NewListName; //02.04.2013 AOldListParams^.Name;//NewListName;
vList.Caption := fullname;
GetTag := vList.Tag;
// èçìåíèòü íàçâàíèå â ïåðåêëþ÷àòåëå ëèñòîâ
for j := 0 to FSCS_Main.pageCADList.PageCount - 1 do
begin
if FSCS_Main.pageCADList.Pages[j].Tag = GetTag then
begin
// 2011-05-10
FSCS_Main.pageCADList.Pages[j].Caption := fullname;
break;
end;
end;
// èçìåíèòü íàçâàíèå â ìåíþ ëèñòîâ
for j := 0 to FSCS_Main.mainWindow.Count - 1 do
begin
if FSCS_Main.mainWindow.Items[j].Tag = GetTag then
begin
// 2011-05-10
FSCS_Main.mainWindow.Items[j].Caption := fullname;
break;
end;
end;
// RenameListOnFrame(vList);
// 2011-05-10
if ARenameOnFrame and Assigned(AOldListParams) then
RenameListOnFrame(vList, GetCurrProjectParams(false), AOldListParams^);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.RenameListInCAD', E.Message);
end;
end;
// ÏÐÈ ÓÄÀËÅÍÈÈ ËÈÑÒÀ Â ÌÏ ÓÄÀËÈÒÜ ÅÃÎ ÍÀ CAD-å
Procedure DeleteListInCAD(AID_List: Integer; ListName: String);
var
i: integer;
BoxID: Integer;
BoxListID: Integer;
BoxObject: TConnectorObject;
BoxListObject: TF_CAD;
vList: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
if vList.FListType = lt_DesignBox then
begin
BoxID := vList.FJoinedBoxIDForDesignList;
BoxListID := vList.FJoinedListIDForDesignList;
BoxListObject := GetListByID(BoxListID);
BoxObject := TConnectorObject(GetFigureByID(BoxListObject, BoxID));
if BoxObject <> nil then
BoxObject.FJoinedListIDForBox := -1;
end;
GCurrentCADListID := AID_List;
vList.FNeedDelete := True;
GNotNeedCheckRaisesBeforeClose := True;
vList.Close;
GNotNeedCheckRaisesBeforeClose := False;
vList.FNeedDelete := False;
GCurrentCADListID := 0;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.DeleteListInCAD', E.Message);
end;
end;
Procedure FindConnectionsInterfaces(AConnector1, AConnector2: TConnectorObject);
var
i: integer;
isConnected: Boolean;
ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam;
ParamsList1, ParamsList2: TList;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
begin
try
ParamsList1 := TList.create;
ParamsList2 := TList.create;
// 1 ñîåäèíèòåëü
for i := 0 to AConnector1.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnector1.JoinedOrtholinesList[i]);
New(ptrInterfRecord1);
ptrInterfRecord1.IDObject := JoinedLine.ID;
if AConnector1 = JoinedLine.JoinConnector1 then
ptrInterfRecord1.Side := 1;
if AConnector1 = JoinedLine.JoinConnector2 then
ptrInterfRecord1.Side := 2;
ParamsList1.Add(ptrInterfRecord1);
end;
// äâà ñîåäèíèòåëÿ - ñîåäèíåíèÿ èõ êàáåëåé
if (AConnector1.ConnectorType = ct_Clear) and (AConnector2.ConnectorType = ct_Clear) then
begin
for i := 0 to AConnector2.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnector2.JoinedOrtholinesList[i]);
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := JoinedLine.ID;
if AConnector2 = JoinedLine.JoinConnector1 then
ptrInterfRecord2.Side := 1;
if AConnector2 = JoinedLine.JoinConnector2 then
ptrInterfRecord2.Side := 2;
ParamsList2.Add(ptrInterfRecord2);
end;
end;
// ñîåäèíèòåëü ñ îáüåêòîì - ñîåäèíåíèå êàáåëåé ñ îáüåêòîì
if (AConnector1.ConnectorType = Ct_Clear) and (AConnector2.ConnectorType <> Ct_Clear) then
begin
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := AConnector2.ID;
ptrInterfRecord2.Side := -1;
ParamsList2.Add(ptrInterfRecord2);
end;
// Ñîåäèíèòü
isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2);
except
on E: Exception do addExceptionToLogEx('U_Common.FindConnectionsInterfaces', E.Message);
end;
end;
{******************************************************************************}
procedure AutoConnectOnAppendCable(AID_List, AID_Line: Integer);
var
i, j: integer;
JoinedConn1, JoinedConn2: TConnectorObject;
JoinedObject: TConnectorObject;
JoinedLine: TOrthoLine;
isConnected: Boolean;
ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam;
ParamsList1, ParamsList2: TList;
ACable: TOrthoLine;
vList: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
ACable := TOrthoLine(GetFigureByID(vList, AID_Line));
if ACable = Nil then
Exit;
if not CheckFigureByClassName(ACable, cTOrthoLine) then
Exit;
ParamsList1 := TList.Create;
ParamsList2 := TList.Create;
// èíòåðôåéñû êàáåëÿ
New(ptrInterfRecord1);
ptrInterfRecord1.IDObject := ACable.ID;
ptrInterfRecord1.Side := 1;
ParamsList1.Add(ptrInterfRecord1);
{***** 1 êîíåêòîð! *****}
JoinedConn1 := TConnectorObject(ACable.JoinConnector1);
// ===== ïðîâåðèòü âñå ïîäñîåäèíåííûå îðòîëèíèè =====
for i := 0 to JoinedConn1.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn1.JoinedOrtholinesList[i]);
if JoinedLine <> ACable then
begin
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := JoinedLine.ID;
if JoinedConn1 = JoinedLine.JoinConnector1 then
ptrInterfRecord2.Side := 1;
if JoinedConn1 = JoinedLine.JoinConnector2 then
ptrInterfRecord2.Side := 2;
ParamsList2.Add(ptrInterfRecord2);
end;
end;
// ===== ïðîâåðèòü âñå ïîäñîåäèíåííûå îáüåêòû =====
for i := 0 to JoinedConn1.JoinedConnectorsList.Count - 1 do
begin
JoinedObject := JoinedConn1.JoinedConnectorsList[i];
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := JoinedObject.ID;
ptrInterfRecord2.Side := -1;
ParamsList2.Add(ptrInterfRecord2);
end;
isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2);
ParamsList1 := TList.Create;
ParamsList2 := TList.Create;
// èíòåðôåéñû êàáåëÿ
New(ptrInterfRecord1);
ptrInterfRecord1.IDObject := ACable.ID;
ptrInterfRecord1.Side := 2;
ParamsList1.Add(ptrInterfRecord1);
{***** 2 êîíåêòîð! *****}
JoinedConn2 := TConnectorObject(ACable.JoinConnector2);
// ===== ïðîâåðèòü âñå ïîäñîåäèíåííûå îðòîëèíèè =====
for i := 0 to JoinedConn2.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn2.JoinedOrtholinesList[i]);
if JoinedLine <> ACable then
begin
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := JoinedLine.ID;
if JoinedConn2 = JoinedLine.JoinConnector1 then
ptrInterfRecord2.Side := 1;
if JoinedConn2 = JoinedLine.JoinConnector2 then
ptrInterfRecord2.Side := 2;
ParamsList2.Add(ptrInterfRecord2);
end;
end;
// ===== ïðîâåðèòü âñå ïîäñîåäèíåííûå îáüåêòû =====
for i := 0 to JoinedConn2.JoinedConnectorsList.Count - 1 do
begin
JoinedObject := JoinedConn2.JoinedConnectorsList[i];
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := JoinedObject.ID;
ptrInterfRecord2.Side := -1;
ParamsList2.Add(ptrInterfRecord2);
end;
isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.AutoConnectOnAppendCable', E.Message);
end;
end;
procedure AutoConnectObjectInTrace(APointObject: TConnectorObject;
ATrace1, ATrace2: TOrthoLine);
var
i: integer;
isConnected: Boolean;
ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam;
ParamsList1, ParamsList2: TList;
begin
try
ParamsList1 := TList.create;
ParamsList2 := TList.create;
FreeLineFigureInterfaces(ATrace1.ID, 2);
New(ptrInterfRecord1);
ptrInterfRecord1.IDObject := APointObject.ID;
ptrInterfRecord1.Side := -1;
ParamsList1.Add(ptrInterfRecord1);
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := ATrace1.ID;
ptrInterfRecord2.Side := 2;
ParamsList2.Add(ptrInterfRecord2);
isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2);
except
on E: Exception do addExceptionToLogEx('U_Common.AutoConnectObjectInTrace', E.Message);
end;
end;
procedure AutoConnectObjectToConnectors(APointObject, AConnectedConn: TConnectorObject; AConnectorsList: TList);
var
i, j: integer;
ConnectorsCount: integer;
isConnected: Boolean;
CurrentConn: TConnectorObject;
Joinedline: TOrthoLine;
ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam;
ParamsList1, ParamsList2: TList;
begin
BaseBeginUpdate;
try
// î÷èñòèòü èíòåðôåéñû êàáåëåé
for i := 0 to AConnectorsList.Count - 1 do
begin
CurrentConn := TConnectorObject(AConnectorsList[i]);
for j := 0 to CurrentConn.JoinedOrtholinesList.Count - 1 do
begin
Joinedline := TOrthoLine(CurrentConn.JoinedOrtholinesList[j]);
if Joinedline.JoinConnector1 = CurrentConn then
FreeLineFigureInterfaces(Joinedline.ID, 1);
if Joinedline.JoinConnector2 = CurrentConn then
FreeLineFigureInterfaces(Joinedline.ID, 2);
end;
end;
CurrentConn := AConnectedConn;
for j := 0 to CurrentConn.JoinedOrtholinesList.Count - 1 do //
begin //
Joinedline := TOrthoLine(CurrentConn.JoinedOrtholinesList[j]); //
if Joinedline.JoinConnector1 = CurrentConn then //Íàõåð ýòîò êóñîê êîäà òóò íå íóæåí.
FreeLineFigureInterfaces(Joinedline.ID, 1); //
if Joinedline.JoinConnector2 = CurrentConn then //
FreeLineFigureInterfaces(Joinedline.ID, 2); //
end; //
ParamsList1 := TList.create;
ParamsList2 := TList.create;
// ïåðâûé ïàðàìåòð - ïðèñîåäèíÿåìûé êîííåêòîð
New(ptrInterfRecord1);
for i := 0 to AConnectedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnectedConn.JoinedOrtholinesList[i]);
ptrInterfRecord1.IDObject := Joinedline.ID;
if Joinedline.JoinConnector1 = CurrentConn then
ptrInterfRecord1.Side := 1;
if Joinedline.JoinConnector2 = CurrentConn then
ptrInterfRecord1.Side := 2;
ParamsList1.Add(ptrInterfRecord1);
end;
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := APointObject.ID;
ptrInterfRecord2.Side := -1;
ParamsList2.Add(ptrInterfRecord2);
for ConnectorsCount := 0 to AConnectorsList.Count - 1 do
begin
CurrentConn := TConnectorObject(AConnectorsList[ConnectorsCount]);
for i := 0 to CurrentConn.JoinedOrtholinesList.Count - 1 do
begin
Joinedline := TOrthoLine(CurrentConn.JoinedOrtholinesList[i]);
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := Joinedline.ID;
if Joinedline.JoinConnector1 = CurrentConn then
ptrInterfRecord2.Side := 1;
if Joinedline.JoinConnector2 = CurrentConn then
ptrInterfRecord2.Side := 2;
ParamsList2.Add(ptrInterfRecord2);
end;
end;
isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2);
except
on E: Exception do addExceptionToLogEx('U_Common.AutoConnectObjectToConnectors', E.Message);
end;
BaseEndUpdate;
end;
Procedure AppendLineInterfacesToCAD(AID_List, AID_Figure: Integer; AObjName: string; aDivValue: Double);
var
vList: TF_CAD;
vLine: TOrthoLine;
SavedSnapFigure: TFigure;
begin
try
vList := getListByID(AID_List);
if vList <> nil then
begin
if vList.FAllowSuppliesKind then
begin
if vList.FSCSType = st_Internal then
begin
vLine := TOrthoLine(GetFigureByID(vList, AID_Figure));
if (vLine <> nil) and (not vLine.FIsRaiseUpDown) then
begin
if aDivValue > 0 then
begin
SavedSnapFigure := GFigureSnap;
vList.AutoDivideTraceOnAppendCable(vLine, aDivValue);
GFigureSnap := SavedSnapFigure;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.AppendLineInterfacesToCAD', E.Message);
end;
end;
Procedure RemoveLineInterfacesFromCAD(AID_List, AID_Figure: Integer; AObjName: string);
begin
end;
// ÂÁÐÎÑ ÍÅËÈÍÅÉÍÎÃÎ ÊÎÌÏÎÍÅÍÒÀ Â ÏÌ
Procedure AppendNoLineInterfacesToCAD(AID_List, AID_Figure: Integer; AObjName: string);
var
i: integer;
CADFigure: TConnectorObject;
isEmpty: Boolean;
NewConn: TConnectorObject;
LHandle: integer;
GetConn: TConnectorObject;
//
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
ObjFromRaise: TConnectorObject;
ObjParams: TObjectParams;
vList: TF_CAD;
SavedCadForm: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
SavedCadForm := GCadForm;
GCadForm := vList;
LHandle := vList.PCad.GetLayerHandle(2);
// Find Figure In CAD
CADFigure := TConnectorObject(GetFigureByID(vList, AID_Figure));
if CADFigure = nil then
Exit;
isEmpty := IsEmptyFigure(CADFigure.ID);
//Tolik
if (CADFigure.ConnectorType = ct_Clear) and (isEmpty = False) and GDragOnCAD then
begin
NewConn := TConnectorObject.Create(CADFigure.ActualPoints[1].x, CADFigure.ActualPoints[1].y, vList.FConnHeight,
LHandle, mydsNormal, vList.PCad);
NewConn.ConnectorType := ct_Clear;
NewConn.ActualZOrder[1] := CADFigure.ActualZOrder[1];
vList.PCad.AddCustomFigure (GLN(LHandle), NewConn, False);
for i := 0 to CADFigure.JoinedOrtholinesList.Count - 1 do
begin
GetConn := TConnectorObject(TOrthoLine(CADFigure.JoinedOrtholinesList[i]).JoinConnector1);
if GetConn = CADFigure then
TOrthoLine(CADFigure.JoinedOrtholinesList[i]).SetJConnector1(NewConn);
GetConn := TConnectorObject(TOrthoLine(CADFigure.JoinedOrtholinesList[i]).JoinConnector2);
if GetConn = CADFigure then
TOrthoLine(CADFigure.JoinedOrtholinesList[i]).SetJConnector2(NewConn);
end;
NewConn.FConnRaiseType := CADFigure.FConnRaiseType;
NewConn.FObjectFromRaise := CADFigure.FObjectFromRaise;
NewConn.FID_ListToPassage := CADFigure.FID_ListToPassage;
NewConn.FID_ConnToPassage := CADFigure.FID_ConnToPassage;
CADFigure.FConnRaiseType := crt_None;
CADFigure.FObjectFromRaise := nil;
CADFigure.JoinedOrtholinesList.Clear;
CADFigure.ConnectorType := ct_NB;
ObjParams := GetFigureParams(CADFigure.ID);
CADFigure.Name := ObjParams.Name;
CADFigure.FIndex := ObjParams.MarkID;
if not HaveObjectCorkComponent(AID_Figure) then
CADFigure.ActualZOrder[1] := vList.FConnHeight;
CheckingSnapPointObjectToConnector(CADFigure, NewConn);
SetConnObjectSelectHightPriority(CADFigure); //#From Oleg# //29.09.2010
end;
RefreshCAD(vList.PCad);
GCadForm := SavedCadForm;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.AppendNoLineInterfacesToCAD', E.Message);
end;
end;
// ÓÄÀËÈÒÜ ÍÅËÈÍÅÉÍÎÃÎ ÊÎÌÏÎÍÅÍÒÀ ÈÇ ÏÌ
Procedure RemoveNoLineInterfacesFromCAD(AID_List, AID_Figure: Integer; AObjName: string);
var
i, j: integer;
CADFigure: TConnectorObject;
isEmpty: Boolean;
NewConn: TConnectorObject;
GetConn: TConnectorObject;
GetLine: TOrthoLine;
LHandle: integer;
ObjParams: TObjectParams;
vList: TF_CAD;
SavedCadForm: TF_CAD;
//Tolik
CADFigureParentCatalog: TSCSCatalog;
CanDelRaise: Boolean;
connectorDeleted: Boolean;
joinConnCount: Integer;
DelFigure: TConnectorObject;
//
begin
//Tolik
CanDelRaise := False;
CADFigureParentCatalog := nil;
connectorDeleted := False;
DelFigure := nil;
//
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
SavedCadForm := GCadForm;
GCadForm := vList;
LHandle := vList.PCad.GetLayerHandle(2);
CADFigure := TConnectorObject(GetFigureByID(vList, AID_Figure));
if CADFigure = nil then
Exit;
isEmpty := IsEmptyFigure(CADFigure.ID);
//Tolik
CADFigureParentCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(CadFigure.ID);
if CADFigureParentCatalog <> nil then
begin
if CADFigureParentCatalog.ComponentReferences.Count = 0 then
CanDelRaise := true;
end;
joinConnCount := CADFigure.JoinedConnectorsList.Count;
//
if (CADFigure.ConnectorType <> ct_Clear) and (isEmpty = True) then
begin
if GTempJoinedLinesConnectors <> nil then
GTempJoinedLinesConnectors.Clear;
for i := 0 to CADFigure.JoinedConnectorsList.Count - 1 do
begin
GetConn := TConnectorObject(CADFigure.JoinedConnectorsList[i]);
GTempJoinedLinesConnectors.Add(GetConn);
for j := 0 to GetConn.JoinedOrtholinesList.Count - 1 do
begin
GetLine := TOrthoLine(GetConn.JoinedOrtholinesList[j]);
// Tolik
if GetLine.FIsRaiseUpDown then
begin
if CanDelRaise and (GetConn.JoinedOrtholinesList.Count = 1) and (CADFigure.JoinedConnectorsList.Count = 1) then
//GetLine.Delete;
//GetConn.Delete(True, False);
//connectorDeleted := true;
end
else
begin
//
if GetLine.JoinConnector1 = GetConn then
begin
GetLine.SetJConnector1(CADFigure);
GetLine.ActualPoints[1] := CADFigure.ActualPoints[1];
end;
if GetLine.JoinConnector2 = GetConn then
begin
GetLine.SetJConnector2(CADFigure);
GetLine.ActualPoints[2] := CADFigure.ActualPoints[1];
end;
//Tolik
end;
//
end;
GetConn.JoinedOrtholinesList.Clear;
GetConn.JoinedConnectorsList.Clear;
end;
CADFigure.JoinedConnectorsList.Clear;
CADFigure.ConnectorType := ct_Clear;
if CADFigure.FConnRaiseType = crt_None then
CADFigure.Name := cCadClasses_Mes12
else
CADFigure.Name := cCadClasses_Mes24;
SetNewObjectNameInPM(CADFigure.ID, CADFigure.Name);
ObjParams := GetFigureParams(CADFigure.ID);
CADFigure.Name := ObjParams.Name;
CADFigure.FIndex := ObjParams.MarkID;
{ for i := 0 to GTempJoinedLinesConnectors.Count - 1 do
TConnectorObject(GTempJoinedLinesConnectors[i]).Delete(False);}
end;
//Tolik
if not connectorDeleted then
for i := 0 to GTempJoinedLinesConnectors.Count - 1 do
TConnectorObject(GTempJoinedLinesConnectors[i]).Delete(False)
else
GTempJoinedLinesConnectors.Clear;
//Tolik
if (connectorDeleted or (JoinConnCount = 0)) then
//CADFigureParentCatalog.Delete; // òàê äåëàòü íå áóäåì, ïîòîìó, ÷òî åñëè åñòü Ñ/Ï íà êîííåêòîðå,
// òî åãî òðåáóåòñÿ îñòàâèòü (õç, ÷òî íàäî êëèåíòó), òàê ÷òî
// áóäåì óäàëÿòü êîíêðåòíî ÷åðåç ôèãóðó (òóò ÷èòàé - TConnecotrObject) ñ
// ïàðàìåòðîì "íå óäàëÿòü Ñ/Ï"
begin
for i := 0 to vList.PCad.Figures.Count - 1 do
begin
if Tfigure(vList.PCad.Figures[i]).ID = CADFigureParentCatalog.SCSID then
begin
DelFigure := TConnectorObject(vList.PCad.Figures[i]);
break;
end;
end;
end;
if DelFigure <> nil then
DelFigure.Delete(True, False);
//
RefreshCAD(vList.PCad);
GCadForm := SavedCadForm;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.RemoveNoLineInterfacesFromCAD', E.Message);
end;
end;
// ÂÛÄÅËÈÒÜ ÒÐÀÑÑÓ ÍÀ CAD-å
function SelectTraceInCAD(LinesList: TList): Double;
var
i, j: integer;
IDInterf: ^Integer;
ID: Integer;
vFigure: TFigure;
vList: TF_CAD;
CadsToRefresh: TList; //17.01.2011
//Figures: TList; //15.02.2011
CurrTick, OldTick: Cardinal;
begin
Result := 0;
try
CadsToRefresh := nil;
DeselectTraceInCAD; //15.02.2011
OldTick := GetTickCount;
for i := 0 to LinesList.Count - 1 do
begin
IDInterf := LinesList[i];
ID := IDInterf^;
for j := 0 to FSCS_Main.MDIChildCount - 1 do
begin
vList := TF_CAD(FSCS_Main.MDIChildren[j]);
if (vList <> nil) and (vList.PCad <> nil) and (vList.FAutoSelectTrace) and (vList.FListType = lt_Normal) then
begin
vFigure := TFigure(vList.FSCSFigures.GetObject(ID)); //17.01.2013 vFigure := GetFigureByID(vList, ID);
if (vFigure <> nil) and CheckFigureByClassName(vFigure, cTOrthoLine) then
begin
TOrthoLine(vFigure).isTraceShow := True;
Result := Result + TOrthoLine(vFigure).LineLength;
//17.01.2011 - Ñïèñîê ëèñòîâ äëÿ ïåðåðèñîâêè
if CadsToRefresh = nil then
CadsToRefresh := TList.Create;
if CadsToRefresh.IndexOf(vList) = -1 then
CadsToRefresh.Add(vList);
end;
end;
end;
end;
CurrTick := GetTickCount - OldTick;
CurrTick := GetTickCount - OldTick;
if CadsToRefresh <> nil then
begin
RefreshCADs(CadsToRefresh);
CadsToRefresh.Free;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SelectTraceInCAD', E.Message);
end;
end;
// ÓÁÐÀÒÜ ÂÛÄÅËÅÍÈÅ ÒÐÀÑÑÛ ÍÀ CAD-å
function DeselectTraceInCAD: Boolean;
var
i, j: integer;
IDInterf: ^Integer;
ID: Integer;
vFigure: TFigure;
vList: TF_CAD;
begin
Result := false;
try
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
vList := TF_CAD(FSCS_Main.MDIChildren[i]);
if (vList <> nil) and (vList.PCad <> nil) and (vList.FAutoSelectTrace) and (vList.FListType = lt_Normal) then
begin
if vList.FNeedUpdateCheckedFigures then
vList.UpdateCheckedFigures;
for j := 0 to vList.FCheckedFigures.Count - 1 do
//for j := 0 to vList.PCad.FigureCount - 1 do
begin
//vFigure := TFigure(vList.PCad.Figures[j]);
vFigure := TFigure(vList.FCheckedFigures[j]);
if CheckFigureByClassName(vFigure, cTOrthoLine) then
if TOrthoLine(vFigure).isTraceShow then
begin
TOrthoLine(vFigure).isTraceShow := False;
Result := true;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.DeselectTraceInCAD', E.Message);
end;
end;
function GetLineAngle(AP1, AP2: TDoublePoint): Double;
var
Len_X, Len_Y: Double;
AngleRad: Double;
AddAngle: Double;
begin
Result := 0;
try
Len_X := Abs(AP1.x - AP2.x);
Len_Y := Abs(AP1.y - AP2.y);
// ïðîâåðêè è âû÷èëåíèå óãëà â ãðàäóñàõ
AddAngle := 0;
AngleRad := 0;
// äëÿ íåîðòîãîíàëüíûõ ëèíèé
if (AP1.x < AP2.x) and (AP1.y < AP2.y) then // 1
begin
AngleRad := ArcTan2(Len_Y, Len_X); // óãîë â ðàäèàíàõ
AddAngle := 0;
end;
if (AP1.x > Ap2.x) and (AP1.y < AP2.y) then //2
begin
AngleRad := ArcTan2(Len_X, Len_Y); // óãîë â ðàäèàíàõ
AddAngle := 90;
end;
if (AP1.x > AP2.x) and (AP1.y > AP2.y) then //3
begin
AngleRad := ArcTan2(Len_Y, Len_X); // óãîë â ðàäèàíàõ
AddAngle := 180;
end;
if (AP1.x < AP2.x) and (AP1.y > AP2.y) then //4
begin
AngleRad := ArcTan2(Len_X, Len_Y); // óãîë â ðàäèàíàõ
AddAngle := 270;
end;
Result := Round(AngleRad * 180 / pi) + AddAngle;
// äëÿ îðòîãîíàëüíûõ ëèíèé
if (AP1.y = AP2.y) and (AP1.x < AP2.x) then
Result := 0;
if (AP1.y = AP2.y) and (AP1.x > AP2.x) then
Result := 180;
if (AP1.x = AP2.x) and (AP1.y < AP2.y) then
Result := 90;
if (AP1.x = AP2.x) and (AP1.y > AP2.y) then
Result := 270;
except
on E: Exception do addExceptionToLogEx('U_Common.TF_OrthoLineProperties.GetAngle', E.Message);
end;
end;
// ÂÛÐÎÂÍßÒÜ ËÈÍÈÞ
Procedure ReAlignLine(aAlignedLine: TOrthoLine);
var
AcceptDelta: Double;
JoinedConn1, JoinedConn2: TConnectorObject;
Points1, Points2: TDoublePoint;
SnapPoint1, SnapPoint2: Double;
delta1, delta2: Double;
ReAlignX, ReAlignY: Boolean;
begin
try
JoinedConn1 := TConnectorObject(aAlignedLine.JoinConnector1);
JoinedConn2 := TConnectorObject(aAlignedLine.JoinConnector2);
Points1 := JoinedConn1.ActualPoints[1];
Points2 := JoinedConn2.ActualPoints[2];
AcceptDelta := GCadForm.PCad.GridStep;
ReAlignX := False;
ReAlignY := False;
if abs(Points1.x - Points2.x) < AcceptDelta then
ReAlignX := True;
if abs(Points1.y - Points2.y) < AcceptDelta then
ReAlignY := True;
if (ReAlignX = True) and (ReAlignY = True) then
ReAlignY := False;
if (ReAlignX = False) and (ReAlignY = False) then
begin
exit;
end;
// âûðàâíèâàíèå ïî ãîðèçîíòàëè
if ReAlignX then
begin
SnapPoint1 := GetCoordsWithSnapToGrid(Points1.x, Points1.y).x;
SnapPoint2 := GetCoordsWithSnapToGrid(Points2.x, Points2.y).x;
if SnapPoint1 = SnapPoint2 then
begin
JoinedConn1.MoveConnector(SnapPoint1 - Points1.x, 0, False);
JoinedConn2.MoveConnector(SnapPoint2 - Points2.x, 0, False);
end
else
begin
delta1 := abs(SnapPoint1 - Points1.x);
delta2 := abs(SnapPoint2 - Points2.x);
if delta1 >= delta2 then
begin
JoinedConn1.MoveConnector(SnapPoint1 - Points1.x, 0, False);
JoinedConn2.MoveConnector(SnapPoint1 - Points2.x, 0, False);
end
else
begin
JoinedConn1.MoveConnector(SnapPoint2 - Points1.x, 0, False);
JoinedConn2.MoveConnector(SnapPoint2 - Points2.x, 0, False);
end;
end;
end;
// âûðàâíèâàíèå ïî âåðòèêàëè
if ReAlignY then
begin
SnapPoint1 := GetCoordsWithSnapToGrid(Points1.x, Points1.y).y;
SnapPoint2 := GetCoordsWithSnapToGrid(Points2.x, Points2.y).y;
if SnapPoint1 = SnapPoint2 then
begin
JoinedConn1.MoveConnector(0, SnapPoint1 - Points1.y, False);
JoinedConn2.MoveConnector(0, SnapPoint2 - Points2.y, False);
end
else
begin
delta1 := abs(SnapPoint1 - Points1.y);
delta2 := abs(SnapPoint2 - Points2.y);
if delta1 >= delta2 then
begin
JoinedConn1.MoveConnector(0, SnapPoint1 - Points1.y, False);
JoinedConn2.MoveConnector(0, SnapPoint1 - Points2.y, False);
end
else
begin
JoinedConn1.MoveConnector(0, SnapPoint2 - Points1.y, False);
JoinedConn2.MoveConnector(0, SnapPoint2 - Points2.y, False);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ReAlignLine', E.Message);
end;
end;
Procedure ReAlignObject(aAlignedObject: TConnectorObject);
var
i: integer;
x, y: Double;
Coords: TDoublePoint;
pt: TDoublePoint;
begin
try
x := aAlignedObject.ActualPoints[1].x;
y := aAlignedObject.ActualPoints[1].y;
Coords := GetCoordsWithSnapToGrid(x, y);
if aAlignedObject.FIsHouseJoined then
begin
for i := 0 to aAlignedObject.FHouse.PointCount - 1 do
begin
pt := aAlignedObject.FHouse.ActualPoints[i];
if aAlignedObject.IsPointIn(pt.x, pt.y) then
begin
aAlignedObject.FHouse.ActualPoints[i] := DoublePoint(Coords.x, Coords.y);
break;
end;
end;
end;
aAlignedObject.MoveConnector(Coords.x - x, Coords.y - y, False);
except
on E: Exception do addExceptionToLogEx('U_Common.ReAlignObject', E.Message);
end;
end;
// ÏÎËÓ×ÈÒÜ ÂÑÞ ÒÐÀÑÑÓ
function GetAllTraceInCAD(AFigureServer, AFigureWS: TFigure): TList;
var
CurrLength: Double;
LastLength: Double;
IDAutoTracingPropertyStr: String;
CurrFigure: TFigure;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
IDCompon: ^Integer;
Res: Boolean;
ptrIDCompon: ^Integer;
i: Integer;
CurrIDPathList: TList;
LastIDPathList: TList;
ResultList: TList;
//////////////////////////////////////////////////////////////////////////////
Procedure GetStepInCAD(ASourceWS: TFigure; AInOrder: TList; ATraveledIndex: Integer);
var
i, j: Integer;
//IDConn: ^Integer;
ComponLength: Double;
ConnectedIDList: TList;
InOrder: TList; //New
begin
ComponLength := 0;
if CheckFigureByClassName(ASourceWS, cTConnectorObject) then
begin
if TConnectorObject(ASourceWS).FDisableTracing then
Exit;
end
else
if CheckFigureByClassName(ASourceWS, cTOrthoLine) then
begin
if TOrthoLine(ASourceWS).FDisableTracing then
Exit;
ComponLength := TOrthoLine(ASourceWS).LineLength;
if (CurrLength + ComponLength >= LastLength) and (LastLength > 0) then
Exit;
end;
CurrLength := CurrLength + ComponLength;
CurrIDPathList.Add(ASourceWS);
if (ASourceWS = AFigureWS) and ((CurrLength <= LastLength) or (LastLength = 0)) then
begin
//*** Ïåðåïðèñâîèòü êðàò÷àéøûé ïóòü
LastIDPathList.Clear;
for i := 0 to CurrIDPathList.Count - 1 do
begin
CurrFigure := TFigure(CurrIDPathList[i]);
LastIDPathList.Add(CurrFigure);
end;
//*** Ïåðåïðèñâîèòü êðàò÷àéøóþ äëèíó
LastLength := CurrLength;
end
else
{************************************************************************}
begin
ConnectedIDList := TList.Create;
if CheckFigureByClassName(ASourceWS, cTConnectorObject) then
begin
// OBJECT
if TConnectorObject(ASourceWS).ConnectorType <> ct_Clear then
begin
for i := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
ConnectedIDList.Add(JoinedLine);
end;
end;
end
// Connector
else
if TConnectorObject(ASourceWS).ConnectorType = ct_Clear then
begin
for j := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[j]);
ConnectedIDList.Add(JoinedConn);
end;
for j := 0 to TConnectorObject(ASourceWS).JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(TConnectorObject(ASourceWS).JoinedOrtholinesList[j]);
ConnectedIDList.Add(JoinedLine);
end;
end;
end
else if CheckFigureByClassName(ASourceWS, cTOrthoLine) then
begin
JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector1);
ConnectedIDList.Add(JoinedConn);
JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector2);
ConnectedIDList.Add(JoinedConn);
end;
InOrder := TList.Create;
if AInOrder <> nil then
InOrder.Assign(AInOrder);
InOrder.Assign(ConnectedIDList, laOr);
for i := 0 to ConnectedIDList.Count - 1 do
begin
CurrFigure := TFigure(ConnectedIDList[i]);
//if CheckNoFigureinList(CurrFigure, AInOrder) and CheckNoFigureinList(CurrFigure, CurrIDPathList) then
//GetStepInCAD(CurrFigure, ConnectedIDList, ATraveledIndex + 1); //Old
if ((AInOrder = nil) or ((AInOrder <> nil) and (AInOrder.IndexOf(CurrFigure) = -1))) and
(CurrIDPathList.IndexOf(CurrFigure) = -1) then
GetStepInCAD(CurrFigure, InOrder, ATraveledIndex + 1);
end;
FreeAndNil(InOrder);
if ConnectedIDList <> nil then
FreeAndNil(ConnectedIDList);
end;
CurrLength := CurrLength - ComponLength;
CurrIDPathList.Delete(ATraveledIndex);
end;
//////////////////////////////////////////////////////////////////////////////
begin
Result := nil;
try
CurrIDPathList := Tlist.Create;
CurrLength := 0;
LastIDPathList := Tlist.Create;
LastLength := 0;
GetStepInCAD(AFigureServer, nil, 0);
begin
ResultList := TList.Create;
for i := 0 to LastIDPathList.Count - 1 do
begin
CurrFigure := TFigure(LastIDPathList[i]);
if CheckFigureByClassName(CurrFigure, cTOrthoLine) then
ResultList.Add(CurrFigure)
else if CheckFigureByClassName(CurrFigure, cTConnectorObject) then
begin
if TConnectorObject(CurrFigure).ConnectorType <> ct_Clear then
ResultList.Add(CurrFigure);
/// **** NEW
if (TConnectorObject(CurrFigure).ConnectorType = ct_Clear) and (TConnectorObject(CurrFigure).FIsHouseJoined) then
ResultList.Add(TConnectorObject(CurrFigure).FHouse);
/// **** NEW
end;
end;
if ResultList.Count = 0 then
FreeAndNil(ResultList)
else
Result := ResultList;
end;
if CurrIDPathList <> nil then
FreeAndNil(CurrIDPathList);
if LastIDPathList <> nil then
FreeAndNil(LastIDPathList);
except
on E: Exception do addExceptionToLogEx('U_Common.GetAllTraceInCAD', E.Message);
end;
end;
// Added by Tolik
// Stolen from Igor but a little bit fully remaked yet
Function GetAllTraceInCADByMarked_New1(aAFigureServer, aAFigureWS: TFigure): TList;
Var i, j, k: Integer;
CurrPath, PassedPath, LineList: TList;
ServerAssigned: boolean;
PathLength: double;
currLine: TOrtholine;
Conn, Conn1: TConnectorObject;
Line: TOrthoLine;
ServerLineConnections, WSLineConnections: Boolean;
DistToServer: array of Double;
LineMoved: Boolean;
currLineLen: double;
CurrTick, OldTick: TDateTime;
Function GetPathLength(aCurrList: TList): Double;
Var
i: Integer;
vFigure: TFigure;
Begin
Result := 0;
for i := 0 to aCurrList.Count - 1 do
begin
vFigure := TFigure(aCurrList[i]);
if CheckFigureByClassName(vFigure, cTOrthoLine) then
Result := Result + TOrthoLine(vFigure).LineLength;
end;
End;
Procedure FindPathToServer(Figure: TFigure; aCurrPath, aPassedPath: TList);
Var i, j, k: Integer;
TmpPath, TmpPassedPath: TList;
TmpLength: double;
TmpLineList: TList;
DistToServer: array of Double;
LineMoved: boolean;
currLineLen: double;
Conn, Conn1: TConnectorObject;
Function CheckFigureInList(aFigure: TFigure; AList: TList): Boolean;
Var i: Integer;
Begin
Result := false;
for i := 0 to AList.Count - 1 do
begin
if aFigure.id = TFigure(AList[i]).id then
begin
result := true;
break;
end;
end;
End;
Begin
try
try
{
TODO: Äîäåëàòü çäåñü ïðîâåðêó çàïðåùåííûõ äëÿ ïðîêëàäêè êàáåëÿ îáúåêòîâ ïî àíàëîãèè ñî ñòàðîé ôóíêöèåé.
Ïîêà áóäåò þçàòüñÿ ñòàðàÿ. Ýòà áóäåò ïî Shift òîëüêî ïîêà
TODO: Äîäåëàòü âîçìîæíîñòü âîçâðàùàòü 1 ñàìûé êîðîòêèé ïóòü è ïàðî÷êó äðóãèõ ïóòåé.
TODO: äîäåëàòü ñ÷åò÷èê âûçîâà ðåêóðñèè äëÿ âîçìîæíîñòè åå ïðåðûâàíèÿ ïîäîáèå ATraveledIndex
}
CurrTick := Now - OldTick;
if CurrTick > 0.00010 then
begin
if CurrPath.Count > 0 then
begin
//ATraveledIndex := ATraveledIndex;
exit;
end;
end;
if CurrTick > 0.00017 then
begin
//ATraveledIndex := ATraveledIndex;
exit;
end;
//if ATraveledIndex > 60 then {40}
// if CurrPath.Count > 0 then
//begin
//ATraveledIndex := ATraveledIndex;
// exit;
//end;
if ((Figure <> nil) and Assigned(Figure)) then
begin
TmpPath := TList.Create;
TmpLineList := TList.Create;
TmpPassedPath := TList.Create;
SetLength(DistToServer, 0);
for i := 0 to aCurrPath.Count - 1 do
TmpPath.Add(aCurrPath[i]);
for i := 0 to aPassedPath.Count - 1 do
TmpPassedPath.Add(aPassedPath[i]);
if not CheckFigureInList(Figure, TmpPath) then
begin
TmpPath.Add(Figure); //Ortholines only
TmpLength := GetPathLength(TmpPath);
if ((PathLength <> 0) and (TmpLength > PathLength)) then
begin
FreeAndNil(TmpPath);
FreeAndNil(TmpLineList);
FreeAndNil(TmpPassedPath);
SetLength(DistToServer, 0);
Exit;
end
else
begin
if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
Line := TOrthoLine(Figure);
Conn := TConnectorObject(Line.JoinConnector1);
if TmpPassedPath.IndexOf(Conn) <> - 1 then
Conn := TConnectorObject(Line.JoinConnector2);
TmpPassedPath.Add(Conn);
for i := 0 to Conn.JoinedConnectorsList.Count - 1 do
begin
TmpPassedPath.Add(TConnectorObject(Conn.JoinedConnectorsList[i]));
if TConnectorObject(Conn.JoinedConnectorsList[i]).ID = TConnectorObject(aAFigureServer).ID then
begin
ServerAssigned := true;
if ((PathLength = 0) or (PathLength > TmpLength )) then
begin
PathLength := TmpLength;
CurrPath.Clear;
for j := 0 to TmpPath.Count - 1 do
begin
CurrPath.Add(TmpPath[j]);
end;
end;
FreeAndNil(TmpPath);
FreeAndNil(TmpLineList);
FreeAndNil(TmpPassedPath);
SetLength(DistToServer, 0);
exit;
end
else
begin
if TConnectorObject(Conn.JoinedConnectorsList[i]).ConnectorType = ct_clear then
begin
for j := 0 to TConnectorObject(Conn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do
begin
if TmpPath.IndexOf(TOrthoLine(TConnectorObject(Conn.JoinedConnectorsList[i]).JoinedOrtholinesList[j])) = -1 then
begin
if TmpLineList.IndexOf(TOrthoLine(TConnectorObject(Conn.JoinedConnectorsList[i]).JoinedOrtholinesList[j])) = -1 then
TmpLineList.Add(TorthoLine(TConnectorObject(Conn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]));
end;
end;
end
else
if TConnectorObject(Conn.JoinedConnectorsList[i]).ConnectorType = ct_NB then
begin
Conn1 := TConnectorObject(Conn.JoinedConnectorsList[i]);
for j := 0 to TConnectorObject(Conn1).JoinedConnectorsList.Count - 1 do
begin
if TmpPassedPath.IndexOf(TConnectorObject(TConnectorObject(Conn1).JoinedConnectorsList[j])) = -1 then
TmpPassedPath.Add(TConnectorObject(TConnectorObject(Conn1).JoinedConnectorsList[j]));
if TConnectorObject(TConnectorObject(Conn1).JoinedConnectorsList[j]).ConnectorType = ct_clear then
begin
for k := 0 to TConnectorObject(TConnectorObject(Conn1).JoinedConnectorsList[j]).JoinedOrtholinesList.Count - 1 do
begin
Line := TConnectorObject(TConnectorObject(Conn1).JoinedConnectorsList[j]).JoinedOrtholinesList[k];
if TmpPath.IndexOf(Line) = -1 then
begin
if TmpLineList.IndexOf(Line) = -1 then
TmpLineList.Add(Line);
end;
end;
end;
end;
end;
end;
end;
for i := 0 to Conn.JoinedOrtholinesList.Count - 1 do
begin
Line := TOrthoLine(Conn.JoinedOrtholinesList[i]);
if TmpPath.IndexOf(Line) = -1 then
begin
if TmpLineList.IndexOf(Line) = -1 then
TmpLineList.Add(Line);
end;
end;
end;
if TmpLineList.Count > 1 then
begin
for j := 0 to TmpLineList.Count - 1 do
begin
Line := TOrthoLine(TmpLineList[j]);
conn := TConnectorObject(Line.JoinConnector1);
if TmpPassedPath.IndexOf(Conn) <> -1 then
conn := TConnectorObject(Line.JoinConnector2);
SetLength(DistToServer, Length(DistToServer) + 1);
// :( ?? íå ñîâïàäàþò êîîðäèíàòû êîííåêòîðà ëèíèè(ñ/ï) è ñåðâåðà (êàê áû íè áðàë...)
{currLineLen := Sqrt( Sqr(Conn.ActualZOrder[1] - TConnectorObject(aAFigureServer).ActualZOrder[1]) +
Sqr(conn.ActualPoints[1].x - TConnectorObject(aAFigureServer).ap1.x) +
Sqr(conn.ActualPoints[1].y - TConnectorObject(aAFigureServer).ap1.y)
);}
currLineLen := Sqrt( Sqr(Conn.ActualZOrder[1] - TConnectorObject(aAFigureServer).ActualZOrder[1]) +
Sqr(conn.ap1.x - TConnectorObject(aAFigureServer).ap1.x) +
Sqr(conn.ap1.y - TConnectorObject(aAFigureServer).ap1.y)
);
DistToServer[Length(DistToServer) - 1] := currLineLen;//GetLineLength(aAFigureServer.ap1, conn.ap1, false);
end;
LineMoved := True;
while LineMoved do
begin
LineMoved := false;
for j := 0 to TmpLineList.Count - 2 do
begin
if DistToServer[j] > DistToServer[j + 1] then
begin
LineMoved := true;
currLineLen := DistToServer[j];
DistToServer[j] := DistToServer[j + 1];
DistToServer[j + 1] := currLineLen;
Line := TOrthoLine(TmpLineList[j]);
TmpLineList[j] := TmpLineList[j + 1];
TmpLineList[j + 1] := Line;
end;
end;
end;
end;
if TmpLineList.Count > 0 then
begin
for i := 0 to TmpLineList.Count - 1 do
FindPathToServer(TmpLineList[i], TmpPath, TmpPassedPath);
end;
FreeAndNil(TmpPath);
FreeAndNil(TmpLineList);
FreeAndNil(TmpPassedPath);
SetLength(DistToServer, 0);
end;
end;
end;
Except
on E: Exception do addExceptionToLogEx('U_Common.GetAllTraceInCADByMarked_New1.FindPathToServer', E.Message);
end;
Finally
if TmpPath <> nil then
FreeAndNil(TmpPath);
if TmpLineList <> nil then
FreeAndNil(TmpLineList);
if TmpPassedPath <> nil then
FreeAndNil(TmpPassedPath);
SetLength(DistToServer, 0);
end;
End;
Begin
OldTick := Now;
try
try
Result := TList.Create; // ïóñòîé ñïèñîê (äëÿ íà÷àëà)
// åñëè âñå åñòü
if ((aAFigureServer <> nil) and (aAFigureWS <> nil)) then
begin
// åñëè ñåðâåð è ñòàíöèÿ òî÷å÷íûå
if (CheckFigureByClassName(aAFigureWS, cTConnectorObject) and CheckFigureByClassName(aAFigureServer, cTConnectorObject)) then
begin
// åñëè ñåðâåð è ñòàíöèÿ - íå îäíî è òîæå
if TConnectorObject(aaFigureWS) <> TConnectorObject(aAFigureServer) then
begin
// èùåì ëèíåéíûå ñîåäèíåíèÿ ó ñòàíöèè è ñåðâåðà (åñëè èõ íå áóäåò - íåò ñìûñëà ïðîäîëæàòü ïîèñê)
// ñíà÷àëà ñòàíöèÿ
WSLineConnections := false;
if TConnectorObject(aAFigureWS).JoinedOrtholinesList.Count > 0 then
WSLineConnections := true;
if not WSLineConnections then
begin
for i := 0 to TConnectorObject(aAfigureWS).JoinedConnectorsList.Count - 1 do
begin
Conn := TConnectorObject(TConnectorObject(aAFigureWS).JoinedConnectorsList[i]);
if Conn.ConnectorType = ct_clear then
begin
if Conn.JoinedOrtholinesList.Count > 0 then
begin
WSLineConnections := true;
break;
end;
end;
end;
end;
ServerLineConnections := false;
if TConnectorObject(aAFigureServer).JoinedOrtholinesList.Count > 0 then
ServerLineConnections := true;
if not ServerLineConnections then
begin
for i := 0 to TConnectorObject(aAFigureServer).JoinedConnectorsList.Count - 1 do
begin
Conn := TConnectorObject(aAFigureServer).JoinedConnectorsList[i];
if Conn.ConnectorType = ct_clear then
begin
if Conn.JoinedOrtholinesList.Count > 0 then
begin
ServerLineConnections := True;
break;
end;
end;
end;
end;
//èùåì ïóòü (Åñëè îáúåêòû(îáà) èìåþò ëèíåéíûå ïîäêëþ÷åíèÿ)
if (ServerLineConnections and WSLineConnections) then
begin
ServerAssigned := false;
CurrPath := TList.Create;
PassedPath := TList.Create;
LineList := TList.Create;
PathLength := 0;
Conn := TConnectorObject(aAFigureWS);
PassedPath.Add(Conn);
// Check direct connected Lines
for i := 0 to TConnectorObject(aAFigureWS).JoinedOrtholinesList.Count - 1 do
begin
Line := TOrthoLine(TConnectorObject(aAFigureWS).JoinedOrtholinesList[i]);
LineList.Add(Line);
Conn := TConnectorObject(Line.JoinConnector1);
if PassedPath.IndexOf(conn) <> - 1 then
Conn := TConnectorObject(Line.JoinConnector2);
for j := 0 to Conn.JoinedConnectorsList.Count - 1 do
begin
if TConnectorObject(Conn.JoinedConnectorsList[j]).ConnectorType = ct_NB then
begin
if TConnectorObject(Conn.JoinedConnectorsList[j]).ID = aAFigureServer.ID then
begin
ServerAssigned := true;
CurrPath.Add(Line);
break;
end;
end
end;
if ServerAssigned then break;
end;
if not ServerAssigned then
begin
// Check Lines connected by connector (to WS)
for i := 0 to TConnectorObject(aAFigureWS).JoinedConnectorsList.Count - 1 do
begin
Conn := TConnectorObject(TConnectorObject(aAFigureWS).JoinedConnectorsList[i]);
PassedPath.Add(Conn);
if Conn.ConnectorType = ct_Clear then
begin
for j := 0 to Conn.JoinedOrtholinesList.Count - 1 do
begin
Line := TOrthoLine(Conn.JoinedOrtholinesList[j]);
LineList.Add(Line);
Conn1 := TConnectorObject(Line.JoinConnector1);
if PassedPath.IndexOf(Conn1) <> -1 then
Conn1 := TConnectorObject(Line.JoinConnector2);
// Look for Server connection
for k := 0 to Conn1.JoinedConnectorsList.Count - 1 do
begin
if ( (TConnectorObject(Conn1.JoinedConnectorsList[k]).ConnectorType = ct_NB) and
(TConnectorObject(Conn1.JoinedConnectorsList[k]).ID = aAFigureServer.ID)) then
begin
ServerAssigned := true;
CurrPath.Add(Line);
Break;
end;
end;
if ServerAssigned then break;
end;
end;
if ServerAssigned then break;
end;
end;
if not ServerAssigned then
begin
// Sorting Lines by Distance to Server
if LineList.Count > 1 then
begin
for j := 0 to LineList.Count - 1 do
begin
Line := TOrthoLine(LineList[j]);
conn := TConnectorObject(Line.JoinConnector1);
if PassedPath.IndexOf(Conn) <> -1 then
conn := TConnectorObject(Line.JoinConnector2);
SetLength(DistToServer, Length(DistToServer) + 1);
DistToServer[Length(DistToServer) - 1] := GetLineLength(aAFigureServer.ap1, conn.ap1);
end;
LineMoved := True;
while LineMoved do
begin
LineMoved := false;
for j := 0 to LineList.Count - 2 do
begin
if DistToServer[j] > DistToServer[j + 1] then
begin
LineMoved := true;
currLineLen := DistToServer[j];
DistToServer[j] := DistToServer[j + 1];
DistToServer[j + 1] := currLineLen;
Line := TOrthoLine(LineList[j]);
LineList[j] := LineList[j + 1];
LineList[j + 1] := Line;
end;
end;
end;
end;
for i := 0 to LineList.Count - 1 do
FindPathToServer(LineList[i], CurrPath, PassedPath);
end;
if not ServerAssigned then
begin
Result.Clear;
FreeAndNil(CurrPath);
end
else
begin
Result.Add(currPath);
end;
FreeAndNil(PassedPath);
FreeAndNil(LineList);
SetLength(DistToServer,0);
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetAllTraceInCADByMarked_New1', E.Message);
end;
Finally
if Result = nil then
begin
if CurrPath <> nil then
FreeAndNil(CurrPath);
end;
if PassedPath <> nil then
FreeAndNil(PassedPath);
if LineList <> nil then
FreeAndNil(LineList);
end;
End;
function GetAllTraceInCADByMarked(aAFigureServer, aAFigureWS: TFigure; SotrListByMarked: Boolean = True): TList;
var
CurrLength: Double;
MinLength: Double;
CurrFigure: TFigure;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
i, j, k: Integer;
CurrIDPathList: TList;
CurrPathList: TList;
ResultList: TList;
tmpResult: TList;
vList1, vList2: TList;
CurrTick, OldTick: TDateTime;
AFigureServer, AFigureWS: TFigure;
//////////////////////////////////////////////////////////////////////////////
Procedure GetStepInCAD(ASourceWS: TFigure; AInOrder: TList; ATraveledIndex: Integer);
var
i, j: Integer;
ConnectedIDList: TList;
InOrder: TList;
begin
if CheckFigureByClassName(ASourceWS, cTConnectorObject) then
begin
if TConnectorObject(ASourceWS).FDisableTracing then
Exit;
end
else if CheckFigureByClassName(ASourceWS, cTOrthoLine) then
begin
if TOrthoLine(ASourceWS).FDisableTracing then
Exit;
end;
CurrTick := Now - OldTick;
if CurrTick > 0.00009 then
begin
if ResultList.Count > 0 then
begin
ATraveledIndex := ATraveledIndex;
exit;
end;
end;
if CurrTick > 0.00013 then
begin
ATraveledIndex := ATraveledIndex;
exit;
end;
if ATraveledIndex > 60 then {40}
if ResultList.Count > 2 then
begin
ATraveledIndex := ATraveledIndex;
exit;
end
else
if ResultList.Count > 100 then
begin
if CurrTick > 0.00006 then
begin
ATraveledIndex := ATraveledIndex;
exit;
end;
end;
CurrIDPathList.Add(ASourceWS);
if (ASourceWS = AFigureWS) then
begin
//*** Ïåðåïðèñâîèòü êðàò÷àéøèé ïóòü
CurrPathList := TList.Create;
for i := 0 to CurrIDPathList.Count - 1 do
begin
CurrFigure := TFigure(CurrIDPathList[i]);
// äîáàâèòü â ëèñò òåêóùåãî ïóòè
if CheckFigureByClassName(CurrFigure, cTOrthoLine) then
CurrPathList.Add(CurrFigure)
else if CheckFigureByClassName(CurrFigure, cTConnectorObject) then
begin
if TConnectorObject(CurrFigure).ConnectorType <> ct_Clear then
CurrPathList.Add(CurrFigure);
/// **** NEW
if (TConnectorObject(CurrFigure).ConnectorType = ct_Clear) and (TConnectorObject(CurrFigure).FIsHouseJoined) then
CurrPathList.Add(TConnectorObject(CurrFigure).FHouse);
/// **** NEW
end;
end;
// äîáàâèòü ñ ëèñò âñåõ ïóòåé
ResultList.Add(CurrPathList);
end
else
{************************************************************************}
begin
ConnectedIDList := TList.Create;
if CheckFigureByClassName(ASourceWS, cTConnectorObject) then
begin
// OBJECT
if TConnectorObject(ASourceWS).ConnectorType <> ct_Clear then
begin
for i := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
ConnectedIDList.Add(JoinedLine);
end;
end;
end
// Connector
else
if TConnectorObject(ASourceWS).ConnectorType = ct_Clear then
begin
for j := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[j]);
ConnectedIDList.Add(JoinedConn);
end;
for j := 0 to TConnectorObject(ASourceWS).JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(TConnectorObject(ASourceWS).JoinedOrtholinesList[j]);
ConnectedIDList.Add(JoinedLine);
end;
end;
end
// Trace
else if CheckFigureByClassName(ASourceWS, cTOrthoLine) then
begin
JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector1);
ConnectedIDList.Add(JoinedConn);
JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector2);
ConnectedIDList.Add(JoinedConn);
end;
InOrder := TList.Create;
if AInOrder <> nil then
InOrder.Assign(AInOrder);
InOrder.Assign(ConnectedIDList, laOr);
for i := 0 to ConnectedIDList.Count - 1 do
begin
CurrFigure := TFigure(ConnectedIDList[i]);
if ((AInOrder = nil) or ((AInOrder <> nil) and (AInOrder.IndexOf(CurrFigure) = -1))) and
(CurrIDPathList.IndexOf(CurrFigure) = -1) then
GetStepInCAD(CurrFigure, InOrder, ATraveledIndex + 1);
end;
FreeAndNil(InOrder);
if ConnectedIDList <> nil then
FreeAndNil(ConnectedIDList);
end;
// CurrLength := CurrLength - ComponLength;
CurrIDPathList.Delete(ATraveledIndex);
end;
//////////////////////////////////////////////////////////////////////////////
function GetMarkedCount(aCurrList: TList): Integer;
var
i: Integer;
vFigure: TFigure;
begin
Result := 0;
for i := 0 to aCurrList.Count - 1 do
begin
vFigure := TFigure(aCurrList[i]);
if CheckFigureByClassName(vFigure, cTOrthoLine) then
if TOrthoLine(vFigure).FMarkTracing then
Result := Result + 1;
end;
end;
function GetPathLength(aCurrList: TList): Double;
var
i: Integer;
vFigure: TFigure;
begin
Result := 0;
for i := 0 to aCurrList.Count - 1 do
begin
vFigure := TFigure(aCurrList[i]);
if CheckFigureByClassName(vFigure, cTOrthoLine) then
Result := Result + TOrthoLine(vFigure).LineLength;
end;
end;
// ***** GET SORTED LIST *****************************************************
function GetSortedResultList(aResList: TList): TList;
var
i, j: Integer;
vList: TList;
vFigure: TFigure;
vLine: TOrthoLine;
vConn: TConnectorObject;
vLength: Double;
vCount: Integer;
ShortestIndex: Integer;
ShortestList: TList;
AllMarkedCount: Integer;
CurrMaxCount: Integer;
MaxIndex: Integer;
begin
Result := TList.Create;
// ïîëó÷èòü êîë-âî îòìå÷åííûõ íà ëèñòå
AllMarkedCount := 0;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
vFigure := TFigure(GCadForm.PCad.Figures[i]);
if CheckFigureByClassName(vFigure, cTOrthoLine) then
if TOrthoLine(vFigure).FMarkTracing then
AllMarkedCount := AllMarkedCount + 1;
end;
// ïîëó÷åíèå ëèñòà ñ íàéêðàò÷àéøèì ïóòåì
ShortestList := nil;
for i := 0 to aResList.Count - 1 do
begin
vList := TList(aResList[i]);
vLength := GetPathLength(vList);
if i = 0 then
begin
MinLength := vLength;
ShortestList := vList;
end
else
if vLength < MinLength then
begin
MinLength := vLength;
ShortestList := vList;
end;
end;
// ñîðòèðîâêà ëèñòîâ ñ îòìå÷åííûìè òðàññàìè
i := 0;
while i < aResList.Count do
begin
vList := TList(aResList[i]);
vCount := GetMarkedCount(vList);
vLength := GetPathLength(vList);
CurrMaxCount := vCount;
MinLength := vLength;
MaxIndex := 0;
for j := 1 to aResList.Count - 1 do
begin
vList := TList(aResList[j]);
vCount := GetMarkedCount(vList);
vLength := GetPathLength(vList);
// íàéäåí ëèñò ñ áîëüøèì êîë-âîì îòìå÷åííûõ
if vCount > CurrMaxCount then
begin
CurrMaxCount := vCount;
MaxIndex := j;
end
else
// êîë-âî îòìå÷åííûõ ñîâïàäàåò, íî äëèííà ïóòè ìåíüøå
if (vCount = CurrMaxCount) and (vLength < MinLength) then
begin
MinLength := vLength;
MaxIndex := j;
end;
end;
if CurrMaxCount > 0 then
Result.Add(aResList[MaxIndex]);
aResList.Delete(MaxIndex);
end;
if Result.IndexOf(ShortestList) = - 1 then
begin
if CheckNoListInList(ShortestList, Result) then
Result.Add(ShortestList);
end;
end;
//function ReverseOrderInLists(aList: TList): TList;
//begin
//end;
begin
OldTick := Now;
AFigureServer := aAFigureWS;
AFigureWS := aAFigureServer;
// AFigureServer := aAFigureServer;
// AFigureWS := aAFigureWS;
Result := nil;
try
ResultList := TList.Create;
// ïîëó÷èòü ïóòü ïî îòìå÷åííûì
CurrIDPathList := TList.Create;
GetStepInCAD(AFigureServer, nil, 0);
if ResultList.Count = 0 then
Result := ResultList
else
//Tolik
// Result := GetSortedResultList(ResultList)
begin
if SotrListByMarked then
Result := GetSortedResultList(ResultList)
else
Result := ResultList;
end;
//
if CurrIDPathList <> nil then
FreeAndNil(CurrIDPathList);
// Ðåâåðñèðîâàòü ýòîò ëèñò (íóæíî äëÿ ïðàâèëüíîãî ïîðÿäêà ñîåäèíåíèé â ÌÏ, ïðè ðó÷íîé òðàññèðîâêè)
// Result := ReverseOrderInLists(Result);
except
on E: Exception do addExceptionToLogEx('U_Common.GetAllTraceInCADByMarked', E.Message);
end;
end;
function CheckConnJoinBetwFloor(aConn: TConnectorObject; CheckRaiseUpDown: boolean = False): Boolean;
var
RaiseConn: TConnectorObject;
begin
Result := false;
RaiseConn := GetRaiseConn(aConn);
if RaiseConn <> nil then
begin
if Not CheckRaiseUpDown then
begin
if RaiseConn.FConnRaiseType in [crt_BetweenFloorUp, crt_BetweenFloorDown] then
Result := true;
end
else
if RaiseConn.FConnRaiseType in [crt_BetweenFloorUp, crt_BetweenFloorDown, crt_TrunkUp, crt_TrunkDown] then
Result := true;
end;
end;
function CheckOtherTraceBetwFloor(Trace: TOrthoLine; CheckRaiseUpDown: boolean = False; CheckMore: boolean = false): Boolean;
var
isBetweenFloor: boolean;
k, kk: integer;
JoinTrace: TOrthoLine;
JoinTrace2: TOrthoLine;
begin
result := False;
isBetweenFloor := False;
try
if Trace.JoinConnector1 <> nil then
begin
for k := 0 to TConnectorObject(Trace.JoinConnector1).JoinedOrtholinesList.Count - 1 do
begin
JoinTrace := TOrthoLine(TConnectorObject(Trace.JoinConnector1).JoinedOrtholinesList.Items[k]);
if ((JoinTrace.FIsRaiseUpDown or JoinTrace.FIsVertical) and CheckRaiseUpDown) or
CheckConnJoinBetwFloor(TConnectorObject(JoinTrace.JoinConnector1), CheckRaiseUpDown) or
CheckConnJoinBetwFloor(TConnectorObject(JoinTrace.JoinConnector2), CheckRaiseUpDown) then
begin
isBetweenFloor := True;
break;
end
else
begin
if (JoinTrace.JoinConnector2 <> nil) and Not isBetweenFloor and CheckMore then
begin
for kk := 0 to TConnectorObject(JoinTrace.JoinConnector1).JoinedOrtholinesList.Count - 1 do
begin
JoinTrace2 := TOrthoLine(TConnectorObject(JoinTrace.JoinConnector1).JoinedOrtholinesList.Items[kk]);
if ((JoinTrace2.FIsRaiseUpDown or JoinTrace2.FIsVertical) and CheckRaiseUpDown) or
CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector1), CheckRaiseUpDown) or
CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector2), CheckRaiseUpDown) then
begin
isBetweenFloor := True;
break;
end;
end;
end;
if (JoinTrace.JoinConnector2 <> nil) and Not isBetweenFloor and CheckMore then
begin
for kk := 0 to TConnectorObject(JoinTrace.JoinConnector2).JoinedOrtholinesList.Count - 1 do
begin
JoinTrace2 := TOrthoLine(TConnectorObject(JoinTrace.JoinConnector2).JoinedOrtholinesList.Items[kk]);
if ((JoinTrace2.FIsRaiseUpDown or JoinTrace2.FIsVertical) and CheckRaiseUpDown) or
CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector1), CheckRaiseUpDown) or
CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector2), CheckRaiseUpDown) then
begin
isBetweenFloor := True;
break;
end;
end;
end;
end;
if isBetweenFloor then
break;
end;
end;
if (Trace.JoinConnector2 <> nil) and Not isBetweenFloor then
begin
for k := 0 to TConnectorObject(Trace.JoinConnector2).JoinedOrtholinesList.Count - 1 do
begin
JoinTrace := TOrthoLine(TConnectorObject(Trace.JoinConnector2).JoinedOrtholinesList.Items[k]);
if ((JoinTrace.FIsRaiseUpDown or JoinTrace.FIsVertical) and CheckRaiseUpDown) or
CheckConnJoinBetwFloor(TConnectorObject(JoinTrace.JoinConnector1), CheckRaiseUpDown) or
CheckConnJoinBetwFloor(TConnectorObject(JoinTrace.JoinConnector2), CheckRaiseUpDown) then
begin
isBetweenFloor := True;
break;
end
else
begin
if (JoinTrace.JoinConnector2 <> nil) and Not isBetweenFloor and CheckMore then
begin
for kk := 0 to TConnectorObject(JoinTrace.JoinConnector1).JoinedOrtholinesList.Count - 1 do
begin
JoinTrace2 := TOrthoLine(TConnectorObject(JoinTrace.JoinConnector1).JoinedOrtholinesList.Items[kk]);
if ((JoinTrace2.FIsRaiseUpDown or JoinTrace2.FIsVertical) and CheckRaiseUpDown) or
CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector1), CheckRaiseUpDown) or
CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector2), CheckRaiseUpDown) then
begin
isBetweenFloor := True;
break;
end;
end;
end;
if (JoinTrace.JoinConnector2 <> nil) and Not isBetweenFloor and CheckMore then
begin
for kk := 0 to TConnectorObject(JoinTrace.JoinConnector2).JoinedOrtholinesList.Count - 1 do
begin
JoinTrace2 := TOrthoLine(TConnectorObject(JoinTrace.JoinConnector2).JoinedOrtholinesList.Items[kk]);
if ((JoinTrace2.FIsRaiseUpDown or JoinTrace2.FIsVertical) and CheckRaiseUpDown) or
CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector1), CheckRaiseUpDown) or
CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector2), CheckRaiseUpDown) then
begin
isBetweenFloor := True;
break;
end;
end;
end;
end;
if isBetweenFloor then
break;
end;
end;
except
end;
result := isBetweenFloor;
end;
function GetAllNoConnectedTraces(aCAD: TF_CAD): TList;
var
i, k, kk: Integer;
Trace: TOrthoLine;
isBetweenFloor: boolean;
// aList: TList;
//function isBetweenFloorExist(TraceCh: TOrthoLine): boolean;
//var
// JoinTrace: TOrthoLine;
// j: integer;
//begin
// result := False;
// if TraceCh.JoinConnector1 <> nil then
// begin
// for j := 0 to TConnectorObject(TraceCh.JoinConnector1).JoinedOrtholinesList.Count - 1 do
// begin
// JoinTrace := TOrthoLine(TConnectorObject(TraceCh.JoinConnector1).JoinedOrtholinesList.Items[j]);
// if aList.IndexOf(JoinTrace) < 0 then
// begin
// aList.Add(JoinTrace);
// if JoinTrace.JoinConnector1 <> nil then
// if (TConnectorObject(JoinTrace.JoinConnector1).FConnRaiseType = crt_BetweenFloorUp)
// or (TConnectorObject(JoinTrace.JoinConnector1).FConnRaiseType = crt_BetweenFloorDown) then
// result := True;
// if result then
// break;
// if JoinTrace.JoinConnector2 <> nil then
// if (TConnectorObject(JoinTrace.JoinConnector1).FConnRaiseType = crt_BetweenFloorUp)
// or (TConnectorObject(JoinTrace.JoinConnector1).FConnRaiseType = crt_BetweenFloorDown) then
// result := True;
// if result then
// break;
// result := isBetweenFloorExist(JoinTrace);
// if result then
// break;
// end;
// end;
// end;
//
// if (TraceCh.JoinConnector2 <> nil) and Not Result then
// begin
// for j := 0 to TConnectorObject(TraceCh.JoinConnector2).JoinedOrtholinesList.Count - 1 do
// begin
// JoinTrace := TOrthoLine(TConnectorObject(TraceCh.JoinConnector2).JoinedOrtholinesList.Items[j]);
// if aList.IndexOf(JoinTrace) < 0 then
// begin
// aList.Add(JoinTrace);
// if JoinTrace.JoinConnector1 <> nil then
// if (TConnectorObject(JoinTrace.JoinConnector1).FConnRaiseType = crt_BetweenFloorUp)
// or (TConnectorObject(JoinTrace.JoinConnector1).FConnRaiseType = crt_BetweenFloorDown) then
// result := True;
// if result then
// break;
// if JoinTrace.JoinConnector2 <> nil then
// if (TConnectorObject(JoinTrace.JoinConnector2).FConnRaiseType = crt_BetweenFloorUp)
// or (TConnectorObject(JoinTrace.JoinConnector2).FConnRaiseType = crt_BetweenFloorDown) then
// result := True;
// if result then
// break;
//
// result := isBetweenFloorExist(JoinTrace);
// if result then
// break;
// end;
// end;
// end;
//end;
begin
// Result := GetAllFiguresByClass(aCAD, TOrthoLine);
// aList := TList.Create;
// for i := Result.Count - 1 downto 0 do
// begin
// Trace := TOrthoLine(Result[i]);
// aList.Clear;
// isBetweenFloor := isBetweenFloorExist(Trace);
// if Trace.FIsRaiseUpDown or Trace.FIsVertical then
// Result.Delete(i)
// else
// if isBetweenFloor then
// Result.Delete(i)
// end;
// aList.Free;
Result := GetAllFiguresByClass(aCAD, TOrthoLine);
for i := Result.Count - 1 downto 0 do
begin
Trace := TOrthoLine(Result[i]);
isBetweenFloor := False;
if Trace.FIsRaiseUpDown or Trace.FIsVertical or
CheckConnJoinBetwFloor(TConnectorObject(Trace.JoinConnector1)) or
CheckConnJoinBetwFloor(TConnectorObject(Trace.JoinConnector2)) then
Result.Delete(i)
else
begin
isBetweenFloor := CheckOtherTraceBetwFloor(Trace);
if isBetweenFloor then
Result.Delete(i)
end;
end;
end;
function CheckNoFigureInList(ACheckFigure: TFigure; AList: TList): Boolean;
var
i: Integer;
begin
Result := true;
try
if AList <> nil then
begin
for i := 0 to AList.Count - 1 do
if ACheckFigure = TFigure(AList[i]) then
begin
Result := false;
Break;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckNoFigureinList', E.Message);
end;
end;
function CheckNoCadInList(ACheckCad: TF_CAD; AList: TList): Boolean;
var
i: Integer;
begin
Result := true;
try
if AList <> nil then
begin
for i := 0 to AList.Count - 1 do
if ACheckCad = TF_CAD(AList[i]) then
begin
Result := false;
Break;
end;
end;
except
on E: Exception do addExceptionToLogEx('CheckNoFigureInList', E.Message);
end;
end;
function CheckNoListInList(AInList, AList: TList): Boolean;
var
i: Integer;
begin
Result := true;
try
if AList <> nil then
begin
for i := 0 to AList.Count - 1 do
if AInList = TList(AList[i]) then
begin
Result := false;
Break;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.CheckNoListInList', E.Message);
end;
end;
function CheckRaise(APointObject: TConnectorObject): Boolean;
var
i, j: integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
MinX, MaxX, MinY, MaxY: Double;
begin
Result := False;
try
// îáúåêò
if APointObject.ConnectorType <> ct_Clear then
begin
for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
if JoinedLine.FObjectFromRaisedLine = APointObject then
Result := True;
end;
end;
end
else
// ñîåäèíèòåëü
begin
for i := 0 to APointObject.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(APointObject.JoinedOrtholinesList[i]);
if JoinedLine.FObjectFromRaisedLine = APointObject then
Result := True;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckRaise', E.Message);
end;
end;
function GetBasisPointByObjFromRaise(aObj: TConnectorObject): TDoublePoint;
begin
Result := DoublePoint(0,0,0);
if aObj.DrawFigure = nil then
begin
Result.x := aObj.ActualPoints[1].x + aObj.GrpSizeX / 2;
Result.y := aObj.ActualPoints[1].y - aObj.GrpSizeY / 2;
end
else
begin
if aObj.DrawFigure.InFigures.Count = 0 then
begin
Result.x := aObj.ActualPoints[1].x + aObj.GrpSizeX / 2;
Result.y := aObj.ActualPoints[1].y - aObj.GrpSizeY / 2;
end
else
begin
Result.x := aObj.DrawFigure.CenterPoint.x + aObj.GrpSizeX / 2 - 0.5;
Result.y := aObj.DrawFigure.CenterPoint.y - aObj.GrpSizeY / 2 + 0.5;
end;
end;
end;
function GetRaiseConn(APointObject: TConnectorObject): TConnectorObject;
var
i, j: integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
MinX, MaxX, MinY, MaxY: Double;
CurConn: TConnectorObject;
begin
Result := nil;
try
if APointObject = nil then
Exit;
// ñîåäèíèòåëü
if APointObject.ConnectorType = ct_Clear then
begin
for i := 0 to APointObject.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(APointObject.JoinedOrtholinesList[i]);
if JoinedLine.FObjectFromRaisedLine = APointObject then
begin
// 1
CurConn := TConnectorObject(JoinedLine.JoinConnector1);
if CurConn.JoinedConnectorsList.Count = 0 then
begin
if CurConn.FObjectFromRaise = APointObject then
Result := CurConn;
end
else
begin
if TConnectorObject(CurConn.JoinedConnectorsList[0]).FObjectFromRaise = APointObject then
Result := TConnectorObject(CurConn.JoinedConnectorsList[0]);
end;
// 2
CurConn := TConnectorObject(JoinedLine.JoinConnector2);
if CurConn.JoinedConnectorsList.Count = 0 then
begin
if CurConn.FObjectFromRaise = APointObject then
Result := CurConn;
end
else
begin
if TConnectorObject(CurConn.JoinedConnectorsList[0]).FObjectFromRaise = APointObject then
Result := TConnectorObject(CurConn.JoinedConnectorsList[0]);
end;
end;
end;
end
else
// îáúåêò
begin
for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
if JoinedLine.FObjectFromRaisedLine = APointObject then
begin
CurConn := TConnectorObject(JoinedLine.JoinConnector1);
if CurConn.JoinedConnectorsList.Count = 0 then
begin
if CurConn.FObjectFromRaise = APointObject then
Result := CurConn;
end
else
begin
if TConnectorObject(CurConn.JoinedConnectorsList[0]).FObjectFromRaise = APointObject then
Result := TConnectorObject(CurConn.JoinedConnectorsList[0]);
end;
// 2
CurConn := TConnectorObject(JoinedLine.JoinConnector2);
if CurConn.JoinedConnectorsList.Count = 0 then
begin
if CurConn.FObjectFromRaise = APointObject then
Result := CurConn;
end
else
begin
if TConnectorObject(CurConn.JoinedConnectorsList[0]).FObjectFromRaise = APointObject then
Result := TConnectorObject(CurConn.JoinedConnectorsList[0]);
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetRaiseConn', E.Message);
end;
end;
function GetRaiseLine(ARaiseConn: TConnectorObject): TOrthoLine;
var
i, j: integer;
ConnectedConn: TConnectorObject;
begin
Result := nil;
try
// Âåðøèíà ñ-ï - ñîåäèíèòåëü
if ARaiseConn.ConnectorType = ct_Clear then
begin
for i := 0 to ARaiseConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(ARaiseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
Result := TOrthoLine(ARaiseConn.JoinedOrtholinesList[i]);
end
else
// Âåðøèíà ñ-ï - Îáúåêò
begin
for i := 0 to ARaiseConn.JoinedConnectorsList.Count - 1 do
begin
ConnectedConn := TConnectorObject(ARaiseConn.JoinedConnectorsList[i]);
for j := 0 to ConnectedConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(ConnectedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then
Result := TOrthoLine(ConnectedConn.JoinedOrtholinesList[j]);
end;
end;
// Correct
if Result <> nil then
begin
if Result.FLineRaiseType = lrt_None then
begin
if ARaiseConn.FObjectFromRaise <> nil then
Result.FLineRaiseType := GetRaiseType(ARaiseConn.FObjectFromRaise, aRaiseConn);
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GerRaiseLine', E.Message);
end;
end;
function GetRaiseByRaiseLine(aRaiseLine: TOrthoLine): TConnectorObject;
begin
Result := nil;
try
if TConnectorObject(aRaiseLine.JoinConnector1).FConnRaiseType <> crt_None then
Result := TConnectorObject(aRaiseLine.JoinConnector1);
if TConnectorObject(aRaiseLine.JoinConnector2).FConnRaiseType <> crt_None then
Result := TConnectorObject(aRaiseLine.JoinConnector2);
except
on E: Exception do addExceptionToLogEx('U_Common.GetRaiseByRaiseLine', E.Message);
end;
end;
// âûñîòà êîìíàòû
Procedure SetCurrListHeightRoom(AHeight: Double);
begin
GCadForm.FRoomHeight := AHeight;
end;
// âûñîòà ïîäâåñíîãî ïîòîëêà
Procedure SetCurrListHeightCeiling(AHeight: Double); //*** äëÿ ïîòîëêà
begin
GCadForm.FFalseFloorHeight := AHeight;
end;
// âûñîòà ðîçåòîê
Procedure SetCurrListHeightSocket(AHeight: Double); //*** äëÿ ðîçåòîê
begin
GCadForm.FConnHeight := AHeight;
end;
// âûäåëèòü ïîäñîåäèíåííûé êîííåêòîð íà CAD
Procedure SelectConnectedConnector(AID_List, AID_Figure: Integer);
var
i: integer;
CAD_Figure: TFigure;
vList: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
CAD_Figure := GetFigureByID(vList, AID_Figure);
if CAD_Figure <> nil then
begin
vList.PCad.DeselectAll(2);
CAD_Figure.Select;
RefreshCAD(vList.PCad);
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SelectConnectedConnector', E.Message);
end;
end;
Procedure SelectConnectedCables(AID_List: Integer; ALinesList: TIntList);
var
FCount: integer;
LCount: integer;
IDInterf: Integer;
ID: Integer;
vList: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
vList.PCad.DeselectAll(2);
for LCount := 0 to ALinesList.Count - 1 do
begin
IDInterf := ALinesList[LCount];
ID := IDInterf;
for FCount := 0 to vList.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(vList.PCad.Figures[FCount]), cTOrthoLine) then
if TFigure(vList.PCad.Figures[FCount]).ID = ID then
TOrthoLine(vList.PCad.Figures[FCount]).Select;
end;
end;
RefreshCAD(vList.PCad);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SelectConnectedCables', E.Message);
end;
end;
// ÑÎÇÄÀÒÜ Ñ-Ï ÍÀ ÎÁÚÅÊÒÅ
procedure CreateRaiseOnPointObject(APointObject: TConnectorObject; AHeight: Double; aBaseConnector: TConnectorObject = nil);
var
ConnectedConn: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
x, y, z: double;
i: integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
JoinedConnBase: TConnectorObject;
ObjParams: TObjectParams;
TempRaisedConnectors: TList;
CurIndex: Integer;
//Tolik
SetRaiseHeight: Double;
RaiseHeight: Double;
ObjFromRaise: TConnectorObject;
begin
BaseBeginUpdate;
try
if CheckJoinVertical(APointObject) then
begin
PutObjectOnHeight(APointObject, AHeight);
BaseEndUpdate;
exit;
end;
x := APointObject.ActualPoints[1].x;
y := APointObject.ActualPoints[1].y;
// Tolik
// z := APointObject.ActualZOrder[1];
if TConnectorObject(APointObject).Radius > 10000000 then
//if TConnectorObject(APointObject).Radius > 11000000 then
begin
if (TConnectorObject(APointObject).Radius - 11000000) <> 999 then
z := TConnectorObject(APointObject).Radius - 11000000
else
z := APointObject.ActualZOrder[1];
end
else
z := APointObject.ActualZOrder[1];
// ñîçäàòü ïðèñîåäèíåííûé êîííåêòîð
ConnectedConn := TConnectorObject.Create(x, y, AHeight, APointObject.LayerHandle, mydsNormal, GCadForm.PCad);
ConnectedConn.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), ConnectedConn, False);
ConnectedConn.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name);
ObjParams := GetFigureParams(ConnectedConn.ID);
ConnectedConn.Name := ObjParams.Name;
ConnectedConn.FIndex := ObjParams.MarkID;
APointObject.ActualZOrder[1] := AHeight;
for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do
TConnectorObject(APointObject.JoinedConnectorsList[i]).ActualZOrder[1] := APointObject.ActualZOrder[1];
SetConFigureCoordZInPM(APointObject.ID, APointObject.ActualZOrder[1]);
// ñîçäàòü ïîäúåì-ñïóñê êîííåêòîð
RaiseConn := TConnectorObject.Create(x + 10, y - 10, z, APointObject.LayerHandle, mydsNormal, GCadForm.PCad);
RaiseConn.ConnectorType := ct_Clear;
// ñîçäàòü ïîäúåì-ñïóñê ëèíèÿ
RaiseLine := TOrthoLine.Create(x, y, AHeight, x + 10, y - 10, z, 1,ord(psSolid), clBlack, 0,
APointObject.LayerHandle, mydsNormal, GCadForm.PCad, False);
RaiseLine.SetJConnector1(TConnectorObject(ConnectedConn));
RaiseLine.SetJConnector2(TConnectorObject(RaiseConn));
// Tolik
RaiseLine.ActualZOrder[1] := ConnectedConn.ActualZOrder[1];
// RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];
if TConnectorObject(APointObject).Radius > 10000000 then
begin
if ((APointObject.Radius - 11000000) <> 999) and ( (APointObject.Radius - 11000000) <> 0) then
RaiseLine.ActualZOrder[2] := APointObject.Radius - 11000000
else
RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];
end
else
RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];
//
SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]);
SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]);
// ïðèêîííåêòèòü ïîäúåì
SnapConnectorToPointObject(ConnectedConn, APointObject, true);
// Tolik
RaiseLine.ActualZOrder[1] := APointObject.ActualZOrder[1];
TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1] := APointObject.ActualZOrder[1];
// RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];
{
if TConnectorObject(APointObject).Radius > 10000000 then
if (APointObject.Radius - 11000000) <> 999 then
RaiseLine.ActualZOrder[2] := APointObject.Radius - 11000000
else
RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];}
//else
// RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];}
//
RaiseConn.MoveConnector(-10, 10, False);
// ÑÎÇÄÀÒÜ ÍÀ ÊÀÄ ===========================================
GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseConn, False);
RaiseConn.Name := cCadClasses_Mes24;
// ???
RaiseConn.FConnRaiseType := crt_OnFloor;
RaiseConn.FObjectFromRaise := APointObject;
SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name);
ObjParams := GetFigureParams(RaiseConn.ID);
RaiseConn.Name := ObjParams.Name;
RaiseConn.FIndex := ObjParams.MarkID;
GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseLine, False);
RaiseLine.Name := cCadClasses_Mes25;
SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name);
ObjParams := GetFigureParams(RaiseLine.ID);
RaiseLine.Name := ObjParams.Name;
RaiseLine.FIndex := ObjParams.MarkID;
RaiseLine.FIsRaiseUpDown := True;
RaiseLine.FObjectFromRaisedLine := APointObject;
RaiseLine.FLineRaiseType := GetRaiseType(APointObject, RaiseConn);
RaiseConn.LockMove := True;
RaiseConn.LockModify := True;
RaiseLine.LockMove := False;
RaiseLine.LockModify := True;
ConnectedConn.LockMove := True;
ConnectedConn.LockModify := True;
// ïåðåïîäñîåäèíèòü òðàññû ê ïîäúåìó
TempRaisedConnectors := TList.Create;
// íåáûëî ïðÿìîé ïðèâÿçêè êîííåêòîðà ê ÒÎ
if aBaseConnector = nil then
begin
for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]);
if JoinedConn <> ConnectedConn then
TempRaisedConnectors.Add(JoinedConn);
end;
end
else
// íåïîñðåäñòâåííî ïðèâÿçêà êîííåêòîðà ê ÒÎ
begin
TempRaisedConnectors.Add(aBaseConnector);
end;
// îòâÿçêà
for i := 0 to TempRaisedConnectors.Count - 1 do
begin
JoinedConn := TConnectorObject(TempRaisedConnectors[i]);
UnsnapConnectorFromPointObject(JoinedConn, APointObject, true);
end;
// ïåðåïðèâÿçêà ê âåðøèíå
CurIndex := TempRaisedConnectors.Count - 1;
// âÿçàòü áåç ñîðòèðîâîê
if aBaseConnector = nil then
begin
for i := CurIndex downto 0 do
begin
JoinedConn := TConnectorObject(TempRaisedConnectors[i]);
SnapConnectorToConnector(JoinedConn, RaiseConn, true);
RaiseConn := JoinedConn;
end;
end
else
// ñ ó÷òîì òîãî ÷òî äîëæåí îñòàòüñÿ òåêóùèé êîííåêòîð, êîòîðûé ñåé÷àñ Move
begin
for i := 0 to TempRaisedConnectors.Count - 1 do
begin
JoinedConn := TConnectorObject(TempRaisedConnectors[i]);
if JoinedConn <> aBaseConnector then
begin
SnapConnectorToConnector(JoinedConn, RaiseConn, true);
RaiseConn := JoinedConn;
end;
end;
SnapConnectorToConnector(aBaseConnector, RaiseConn, true);
RaiseConn := aBaseConnector;
end;
if TempRaisedConnectors <> nil then
FreeAndNil(TempRaisedConnectors);
// Tolik
if (TConnectorObject(APointObject).Radius > 10000000) and ((APointObject.Radius - 11000000) <> 999) and ((APointObject.Radius - 11000000) <> 0) then
begin
RaiseHeight := (APointObject.Radius - 11000000);
RaiseHeight := UOMToMetre(RaiseHeight);
if RaiseConn.FConnRaiseType = crt_OnFloor then
begin
SetRaiseHeight := ObjFromRaise.ActualZOrder[1] + RaiseHeight;
if SetRaiseHeight > GCadForm.FRoomHeight then
SetRaiseHeight := GCadForm.FRoomHeight;
if SetRaiseHeight = ObjFromRaise.ActualZOrder[1] then
begin
if ObjFromRaise.ConnectorType = ct_Clear then
DestroyRaiseOnConnector(ObjFromRaise)
else
DestroyRaiseOnPointObject(ObjFromRaise);
end
else
begin
RaiseConn.ActualZOrder[1] := SetRaiseHeight;
SetConFigureCoordZInPM(RaiseConn.ID, RaiseConn.ActualZOrder[1]);
end;
end
else
// BetweenFloor
begin
SetRaiseHeight := RaiseConn.ActualZOrder[1] - RaiseHeight;
if SetRaiseHeight < 0 then
SetRaiseHeight := 0;
if SetRaiseHeight > GCadForm.FRoomHeight then
SetRaiseHeight := GCadForm.FRoomHeight;
if SetRaiseHeight = RaiseConn.ActualZOrder[1] then
begin
if ObjFromRaise.ConnectorType = ct_Clear then
DestroyRaiseOnConnector(ObjFromRaise)
else
DestroyRaiseOnPointObject(ObjFromRaise);
end
else
begin
ObjFromRaise.ActualZOrder[1] := SetRaiseHeight;
SetConFigureCoordZInPM(ObjFromRaise.ID, ObjFromRaise.ActualZOrder[1]);
end;
end;
end;
RaiseLine.CalculLength := RaiseLine.LengthCalc;
RaiseLine.LineLength := RaiseLine.CalculLength;
SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength);
RaiseLine.ReCreateCaptionsGroup(True, false);
RaiseLine.UpdateLengthTextBox(True, false);
RaiseLine.ReCreateNotesGroup(True);
// ***
for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]);
if JoinedLine <> RaiseLine then
begin
JoinedLine.CalculLength := JoinedLine.LengthCalc;
JoinedLine.LineLength := JoinedLine.CalculLength;
SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength);
JoinedLine.UpdateLengthTextBox(True, false);
JoinedLine.ReCreateDrawFigureBlock;
end;
end;
SetConnBringToFront(APointObject);
SetConnBringToFront(RaiseConn);
RefreshCAD(GCadForm.PCad);
SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name);
{**************************************************************************}
RaiseConn := GetRaiseConn(APointObject);
if RaiseConn <> nil then
AutoConnectOverRaiseInCAD(APointObject, RaiseConn);
{**************************************************************************}
except
on E: Exception do addExceptionToLogEx('U_Common.CreateRaiseOnPointObject', E.Message);
end;
BaseEndUpdate;
end;
// ÈÇÌÅÍÈÒÜ Ñ-Ï ÍÀ ÎÁÚÅÊÒÅ
Procedure ChangeRaiseOnPointObject(APointObject: TConnectorObject; AHeight: Double);
var
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
i, j: integer;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
ObjParams: TObjectParams;
begin
BaseBeginUpdate;
try
JoinedLine := nil;
RaiseLine := nil;
RaiseConn := GetRaiseConn(APointObject);
if RaiseConn <> nil then
RaiseLine := GetRaiseLine(RaiseConn);
// óñòàíîâèòü íîâûå çíà÷åíèÿ
SetConFigureCoordZInPM(APointObject.ID, APointObject.ActualZOrder[1]);
// ñîâïàäàåò ñ ñ-ï, óäàëèòü ñ-ï
if RaiseConn.ActualZOrder[1] = AHeight then
begin
AutoDisconnectOverRaiseInCAD(APointObject, RaiseConn, RaiseLine); //#From Oleg#
if RaiseConn <> nil then
begin
if RaiseConn.ConnectorType = ct_Clear then
RemoveRMWithClear(APointObject, RaiseConn)
else
RemoveRMWithRM(APointObject, RaiseConn);
end;
end
else
// èçìåíèòü âûñîòó
begin
// óñòàíîâèòü íîâûå çíà÷åíèÿ
APointObject.ActualZOrder[1] := AHeight;
SetConnBringToFront(APointObject);
for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := APointObject.JoinedConnectorsList[i];
JoinedConn.ActualZOrder[1] := APointObject.ActualZOrder[1];
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := JoinedConn.JoinedOrtholinesList[j];
if JoinedLine.JoinConnector1 = JoinedConn then
begin
SetLineFigureCoordZInPM(JoinedLine.ID, 1, APointObject.ActualZOrder[1]);
JoinedLine.ActualZOrder[1] := APointObject.ActualZOrder[1];
end;
if JoinedLine.JoinConnector2 = JoinedConn then
begin
SetLineFigureCoordZInPM(JoinedLine.ID, 2, APointObject.ActualZOrder[1]);
JoinedLine.ActualZOrder[2] := APointObject.ActualZOrder[1];
end;
end;
SetConFigureCoordZInPM(JoinedConn.ID, JoinedConn.ActualZOrder[1]);
if JoinedLine <> nil then
begin
JoinedLine.CalculLength := JoinedLine.LengthCalc;
JoinedLine.LineLength := JoinedLine.CalculLength;
SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength);
// Îáíîâèòü ïîëå äëèííû äëÿ îðòîëèíèè
JoinedLine.UpdateLengthTextBox(false, true);
end;
end;
// ïîäúåì-ñïóñê
RaiseLine.FLineRaiseType := GetRaiseType(APointObject, RaiseConn);
// RaiseLine.ReCreateCaptionsGroup(True, true);
RaiseLine.UpdateLengthTextBox(True, true);
RaiseLine.ReCreateNotesGroup(True);
SetConFigureCoordZInPM(APointObject.ID, AHeight);
end;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.ChangeRaiseOnPointObject', E.Message);
end;
BaseEndUpdate;
end;
// ÑÎÇÄÀÒÜ ÎÁÚÅÊÒ ÍÀ ÑÎÅÄÈÍÈÒÅËÅ
Procedure CreateRaiseOnConnector(AConnector: TConnectorObject; AHeight: Double);
var
ConnectedConn: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
x, y, z: double;
i: integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
ObjParams: TObjectParams;
begin
BaseBeginUpdate;
try
if CheckJoinVertical(AConnector) then
begin
PutObjectOnHeight(AConnector, AHeight);
BaseEndUpdate;
exit;
end;
x := AConnector.ActualPoints[1].x;
y := AConnector.ActualPoints[1].y;
z := AConnector.ActualZOrder[1];
// ñîçäàòü ïîäúåì-ñïóñê êîííåêòîð
RaiseConn := TConnectorObject.Create(x, y, AHeight, AConnector.LayerHandle, mydsNormal, GCadForm.PCad);
RaiseConn.ConnectorType := ct_Clear;
// ñîçäàòü ïîäúåì-ñïóñê ëèíèÿ
RaiseLine := TOrthoLine.Create(x, y, AHeight, x, y, z, 1,ord(psSolid), clBlack, 0,
AConnector.LayerHandle, mydsNormal, GCadForm.PCad, False);
RaiseLine.SetJConnector1(TConnectorObject(AConnector));
RaiseLine.SetJConnector2(TConnectorObject(RaiseConn));
RaiseLine.ActualZOrder[1] := AConnector.ActualZOrder[1];
RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];
SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]);
SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]);
// ÑÎÇÄÀÒÜ ÍÀ ÊÀÄ ===========================================
GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseConn, False);
RaiseConn.Name := cCadClasses_Mes24;
SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name);
ObjParams := GetFigureParams(RaiseConn.ID);
RaiseConn.Name := ObjParams.Name;
RaiseConn.FIndex := ObjParams.MarkID;
GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseLine, False);
RaiseLine.Name := cCadClasses_Mes25;
SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name);
ObjParams := GetFigureParams(RaiseLine.ID);
RaiseLine.Name := ObjParams.Name;
RaiseLine.FIndex := ObjParams.MarkID;
RaiseConn.FConnRaiseType := crt_OnFloor;
RaiseConn.FObjectFromRaise := AConnector;
RaiseLine.FIsRaiseUpDown := True;
RaiseLine.FObjectFromRaisedLine := AConnector;
RaiseLine.FLineRaiseType := GetRaiseType(AConnector, RaiseConn);
RaiseLine.CalculLength := RaiseLine.LengthCalc;
RaiseLine.LineLength := RaiseLine.CalculLength;
SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength);
RaiseLine.ReCreateCaptionsGroup(True, false);
RaiseLine.UpdateLengthTextBox(True, false);
RaiseLine.ReCreateNotesGroup(True);
// ***
for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]);
if JoinedLine <> RaiseLine then
begin
JoinedLine.CalculLength := JoinedLine.LengthCalc;
JoinedLine.LineLength := JoinedLine.CalculLength;
SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength);
JoinedLine.UpdateLengthTextBox(True, false);
JoinedLine.ReCreateDrawFigureBlock;
end;
end;
RaiseConn.LockMove := True;
RaiseConn.LockModify := True;
RaiseLine.LockMove := False;
RaiseLine.LockModify := True;
SetConnBringToFront(AConnector);
SetConnBringToFront(RaiseConn);
RefreshCAD(GCadForm.PCad);
{**************************************************************************}
RaiseConn := GetRaiseConn(AConnector);
if RaiseConn <> nil then
AutoConnectOverRaiseInCAD(AConnector, RaiseConn);
except
on E: Exception do addExceptionToLogEx('U_Common.CreateRaiseOnConnector', E.Message);
end;
BaseEndUpdate;
end;
// ÈÇÌÅÍÈÒÜ Ñ-Ï ÍÀ ÑÎÅÄÈÍÈÒÅËÅ
Procedure ChangeRaiseOnConnector(AConnector: TConnectorObject; AHeight: Double);
var
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
i: integer;
ObjParams: TObjectParams;
begin
BaseBeginUpdate;
try
RaiseLine := nil;
if AConnector.FObjectFromRaise <> nil then
RaiseConn := AConnector.FObjectFromRaise
else
RaiseConn := GetRaiseConn(AConnector);
if RaiseConn <> nil then
RaiseLine := GetRaiseLine(RaiseConn);
SetConFigureCoordZInPM(AConnector.ID, AConnector.ActualZOrder[1]);
// ñîâïàäàåò ñ ñ-ï, óäàëèòü ñ-ï
if RaiseConn.ActualZOrder[1] = AHeight then
begin
AutoDisconnectOverRaiseInCAD(AConnector, RaiseConn, RaiseLine); //#From Oleg#
RaiseConn.ActualZOrder[1] := AConnector.ActualZOrder[1];
AConnector.ActualZOrder[1] := AHeight;
end
else
// èçìåíèòü âûñîòó
begin
// óñòàíîâèòü íîâûå çíà÷åíèÿ
AConnector.ActualZOrder[1] := AHeight;
SetConnBringToFront(AConnector);
// ïîäúåì-ñïóñê
RaiseLine.FLineRaiseType := GetRaiseType(AConnector, RaiseConn);
RaiseLine.CalculLength := RaiseLine.LengthCalc;
RaiseLine.LineLength := RaiseLine.CalculLength;
SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength);
// RaiseLine.ReCreateCaptionsGroup(True, True);
RaiseLine.UpdateLengthTextBox(True, true);
RaiseLine.ReCreateNotesGroup(True);
end;
SetConFigureCoordZInPM(AConnector.ID, AHeight);
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.ChangeRaiseOnConnector', E.Message);
end;
BaseEndUpdate;
end;
// ÀÂÒÎÑÎÇÄÀÂÀÒÜ ÍÀ ÏÐÈËÅÃÀÞÙÈÕ ÒÐÀÑÑÀÕ
Procedure CreateRaiseOnNextObject(AConnector: TConnectorObject; AJoinedLine: TOrthoLine; AHeight: Double);
var
PointObject: TConnectorObject;
ConnectedConn: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
x, y, z: double;
i: integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
NextConnector1, NextConnector2: TConnectorObject;
ObjParams: TObjectParams;
isDisconnected: Boolean;
CurrLine: TOrthoLine;
ResPointObject: TConnectorObject;
ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam;
ParamsList1, ParamsList2: TList;
FirstRaiseLine: TOrthoLine;
begin
BaseBeginUpdate;
try
if CheckJoinVertical(AConnector) then
begin
PutObjectOnHeight(AConnector, AHeight);
BaseEndUpdate;
exit;
end;
{******************** ÑÎÅÄÈÍÈÒÅËÜ *****************************************}
if AConnector.JoinedConnectorsList.Count = 0 then
begin
x := AConnector.ActualPoints[1].x;
y := AConnector.ActualPoints[1].y;
z := AConnector.ActualZOrder[1];
// ñîçäàòü ïîäúåì-ñïóñê êîííåêòîð
RaiseConn := TConnectorObject.Create(x, y, AHeight, AConnector.LayerHandle, mydsNormal, GCadForm.PCad);
RaiseConn.ConnectorType := ct_Clear;
// ñîçäàòü ïîäúåì-ñïóñê ëèíèÿ
RaiseLine := TOrthoLine.Create(x, y, z, x, y, AHeight, 1,ord(psSolid), clBlack, 0,
AConnector.LayerHandle, mydsNormal, GCadForm.PCad, False);
RaiseLine.SetJConnector1(TConnectorObject(AConnector));
RaiseLine.SetJConnector2(TConnectorObject(RaiseConn));
RaiseLine.ActualZOrder[1] := AConnector.ActualZOrder[1];
RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];
SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]);
SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]);
// ÑÎÇÄÀÒÜ ÍÀ ÊÀÄ ===========================================
GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseConn, False);
RaiseConn.Name := cCadClasses_Mes24;
SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name);
ObjParams := GetFigureParams(RaiseConn.ID);
RaiseConn.Name := ObjParams.Name;
RaiseConn.FIndex := ObjParams.MarkID;
GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseLine, False);
RaiseLine.Name := cCadClasses_Mes25;
SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name);
ObjParams := GetFigureParams(RaiseLine.ID);
RaiseLine.Name := ObjParams.Name;
RaiseLine.FIndex := ObjParams.MarkID;
RaiseConn.FConnRaiseType := crt_OnFloor;
RaiseConn.FObjectFromRaise := AConnector;
RaiseLine.FIsRaiseUpDown := True;
RaiseLine.FObjectFromRaisedLine := AConnector;
RaiseLine.FLineRaiseType := GetRaiseType(AConnector, RaiseConn);
RaiseLine.CalculLength := RaiseLine.LengthCalc;
RaiseLine.LineLength := RaiseLine.CalculLength;
SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength);
RaiseLine.ReCreateCaptionsGroup(True, false);
RaiseLine.UpdateLengthTextBox(True, false);
RaiseLine.ReCreateNotesGroup(True);
// ***
for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]);
if JoinedLine <> RaiseLine then
begin
JoinedLine.CalculLength := JoinedLine.LengthCalc;
JoinedLine.LineLength := JoinedLine.CalculLength;
SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength);
JoinedLine.UpdateLengthTextBox(True, false);
JoinedLine.ReCreateDrawFigureBlock;
end;
end;
RaiseConn.LockMove := True;
RaiseConn.LockModify := True;
RaiseLine.LockMove := False;
RaiseLine.LockModify := True;
ParamsList1 := TList.create;
ParamsList2 := TList.create;
// ïåðåïîäñîåäèíèòü
if AJoinedLine.JoinConnector1 = AConnector then
begin
//
New(ptrInterfRecord1);
ptrInterfRecord1.IDObject := AJoinedLine.ID;
ptrInterfRecord1.Side := 1;
ParamsList1.Add(ptrInterfRecord1);
//
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
CurrLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]);
if CurrLine <> AJoinedLine then
begin
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := CurrLine.ID;
if CurrLine.JoinConnector1 = AConnector then
ptrInterfRecord2.Side := 1;
if CurrLine.JoinConnector2 = AConnector then
ptrInterfRecord2.Side := 2;
ParamsList2.Add(ptrInterfRecord2);
end;
end;
//
TConnectorObject(AJoinedLine.JoinConnector1).JoinedOrtholinesList.Remove(AJoinedLine);
AJoinedLine.SetJConnector1(TConnectorObject(RaiseConn));
AJoinedLine.ActualZOrder[1] := RaiseConn.ActualZOrder[1];
SetLineFigureCoordZInPM(AJoinedLine.ID, 1, AJoinedLine.ActualZOrder[1]);
end;
if AJoinedLine.JoinConnector2 = AConnector then
begin
//
New(ptrInterfRecord1);
ptrInterfRecord1.IDObject := AJoinedLine.ID;
ptrInterfRecord1.Side := 2;
ParamsList1.Add(ptrInterfRecord1);
//
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
CurrLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]);
if CurrLine <> AJoinedLine then
begin
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := CurrLine.ID;
if CurrLine.JoinConnector1 = AConnector then
ptrInterfRecord2.Side := 1;
if CurrLine.JoinConnector2 = AConnector then
ptrInterfRecord2.Side := 2;
ParamsList2.Add(ptrInterfRecord2);
end;
end;
//
TConnectorObject(AJoinedLine.JoinConnector2).JoinedOrtholinesList.Remove(AJoinedLine);
AJoinedLine.SetJConnector2(TConnectorObject(RaiseConn));
AJoinedLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];
SetLineFigureCoordZInPM(AJoinedLine.ID, 2, AJoinedLine.ActualZOrder[2]);
end;
SetConnBringToFront(AConnector);
SetConnBringToFront(RaiseConn);
ResPointObject := AConnector;
end
else
{******************** ÎÁÚÅÊÒ **********************************************}
begin
PointObject := TConnectorObject(AConnector.JoinedConnectorsList[0]);
x := PointObject.ActualPoints[1].x;
y := PointObject.ActualPoints[1].y;
z := PointObject.ActualZOrder[1];
RaiseConn := GetRaiseConn(PointObject);
FirstRaiseLine := nil;
if RaiseConn = Nil then
begin
// ñîçäàòü ïðèñîåäèíåííûé êîííåêòîð
ConnectedConn := TConnectorObject.Create(x, y, z, PointObject.LayerHandle, mydsNormal, GCadForm.PCad);
ConnectedConn.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(PointObject.LayerHandle), ConnectedConn, False);
ConnectedConn.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name);
ObjParams := GetFigureParams(ConnectedConn.ID);
ConnectedConn.Name := ObjParams.Name;
ConnectedConn.FIndex := ObjParams.MarkID;
// ñîçäàòü ïîäúåì-ñïóñê êîííåêòîð
RaiseConn := TConnectorObject.Create(x + 10, y - 10, AHeight, PointObject.LayerHandle, mydsNormal, GCadForm.PCad);
RaiseConn.ConnectorType := ct_Clear;
// ñîçäàòü ïîäúåì-ñïóñê ëèíèÿ
RaiseLine := TOrthoLine.Create(x, y, z, x + 10, y - 10, AHeight, 1,ord(psSolid), clBlack, 0,
PointObject.LayerHandle, mydsNormal, GCadForm.PCad, False);
RaiseLine.SetJConnector1(TConnectorObject(ConnectedConn));
RaiseLine.SetJConnector2(TConnectorObject(RaiseConn));
RaiseLine.ActualZOrder[1] := ConnectedConn.ActualZOrder[1];
RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];
SetLineFigureCoordZInPM(RaiseLine.ID, 1, AJoinedLine.ActualZOrder[1]);
SetLineFigureCoordZInPM(RaiseLine.ID, 2, AJoinedLine.ActualZOrder[2]);
// ïðèêîííåêòèòü ïîäúåì
SnapConnectorToPointObject(ConnectedConn, PointObject, true);
RaiseConn.MoveConnector(-10, 10, False);
// ÑÎÇÄÀÒÜ ÍÀ ÊÀÄ ===========================================
GCadForm.PCad.AddCustomFigure (GLN(PointObject.LayerHandle), RaiseConn, False);
// ???
RaiseConn.FConnRaiseType := crt_OnFloor;
RaiseConn.FObjectFromRaise := PointObject;
RaiseConn.Name := cCadClasses_Mes24;
SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name);
ObjParams := GetFigureParams(RaiseConn.ID);
RaiseConn.Name := ObjParams.Name;
RaiseConn.FIndex := ObjParams.MarkID;
GCadForm.PCad.AddCustomFigure (GLN(PointObject.LayerHandle), RaiseLine, False);
RaiseLine.Name := cCadClasses_Mes25;
SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name);
ObjParams := GetFigureParams(RaiseLine.ID);
RaiseLine.Name := ObjParams.Name;
RaiseLine.FIndex := ObjParams.MarkID;
RaiseLine.FIsRaiseUpDown := True;
RaiseLine.FObjectFromRaisedLine := PointObject;
RaiseLine.FLineRaiseType := GetRaiseType(PointObject, RaiseConn);
RaiseLine.CalculLength := RaiseLine.LengthCalc;
RaiseLine.LineLength := RaiseLine.CalculLength;
SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength);
RaiseLine.ReCreateCaptionsGroup(True, false);
RaiseLine.UpdateLengthTextBox(True, false);
RaiseLine.ReCreateNotesGroup(True);
// ***
for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]);
if JoinedLine <> RaiseLine then
begin
JoinedLine.CalculLength := JoinedLine.LengthCalc;
JoinedLine.LineLength := JoinedLine.CalculLength;
SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength);
JoinedLine.UpdateLengthTextBox(True, false);
JoinedLine.ReCreateDrawFigureBlock;
end;
end;
RaiseConn.LockMove := True;
RaiseConn.LockModify := True;
RaiseLine.LockMove := False;
// Igor - íå ïîíÿòíî çà÷åì îíî òóò áûëî (òåì áîëåå ïîñëå ïîäíÿòèÿ ñî ñòðèìà îí âñåãäà âèçèáë) - ïîêà çàêîìåíòèë
// D0000006059
//RaiseLine.Visible := False;
RaiseLine.LockModify := True;
ConnectedConn.LockMove := True;
ConnectedConn.LockModify := True;
end
else
begin
FirstRaiseLine := GetRaiseLine(RaiseConn);
if (PointObject <> nil) and (FirstRaiseLine <> nil) then
AutoDisconnectOverRaiseInCAD(PointObject, RaiseConn, FirstRaiseLine); //#From Oleg#
end;
// ïåðåïîäñîåäèíèòü òðàññû ê ïîäúåìó
UnsnapConnectorFromPointObject(AConnector, PointObject, true);
//Tolik
SnapConnectorToConnector(AConnector, RaiseConn, true);
//SnapConnectorToConnector(RaiseConn, AConnector, true);
//
SetConnBringToFront(PointObject);
SetConnBringToFront(AConnector);
ResPointObject := PointObject;
end;
RefreshCAD(GCadForm.PCad);
{**************************************************************************}
RaiseConn := GetRaiseConn(ResPointObject);
if RaiseConn <> nil then
AutoConnectOverRaiseInCAD(ResPointObject, RaiseConn);
{**************************************************************************}
except
on E: Exception do addExceptionToLogEx('U_Common.CreateRaiseOnNextObject', E.Message);
end;
BaseEndUpdate;
end;
// ÀÂÒÎÈÇÌÅÍßÒÜ ÏÎÄÚÅÌ ÍÀ ÏÐÈËÅÃÀÞÙÈÕ ÎÁÚÅÒÀÕ
Procedure ChangeRaiseOnNextObject(AConnector: TConnectorObject; AJoinedLine: TOrthoLine; AHeight: Double);
var
ObjectOnRaise: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
PointObject: TConnectorObject;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
i, j: integer;
ObjParams: TObjectParams;
NewConn: TConnectorObject;
begin
BaseBeginUpdate;
try
JoinedLine := nil; //#From Oleg#
RaiseLine := nil; //#From Oleg#
{************* ÑÎÅÄÈÍÈÒÅËÜ ************************************************}
if AConnector.JoinedConnectorsList.Count = 0 then
begin
if AConnector.FObjectFromRaise <> nil then
RaiseConn := AConnector.FObjectFromRaise
else
RaiseConn := GetRaiseConn(AConnector);
if RaiseConn <> nil then
RaiseLine := GetRaiseLine(RaiseConn);
// óñòàíîâèòü íîâûå çíà÷åíèÿ
SetConFigureCoordZInPM(AConnector.ID, AConnector.ActualZOrder[1]);
// ñîâïàäàåò ñ ñ-ï, óäàëèòü ñ-ï ------------------------------------------
if RaiseConn.ActualZOrder[1] = AHeight then
begin
AutoDisconnectOverRaiseInCAD(AConnector, RaiseConn, RaiseLine); //#From Oleg#
NewConn := TConnectorObject.Create(RaiseConn.ActualPoints[1].x, RaiseConn.ActualPoints[1].y, RaiseConn.ActualZOrder[1],
RaiseConn.LayerHandle, mydsNormal, GCadForm.PCad);
NewConn.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure(2, NewConn, False);
if AJoinedLine.JoinConnector1 = AConnector then
AJoinedLine.SetJConnector1(NewConn);
if AJoinedLine.JoinConnector2 = AConnector then
AJoinedLine.SetJConnector2(NewConn);
AConnector.JoinedOrtholinesList.Remove(AJoinedLine);
if RaiseConn.ConnectorType = ct_Clear then
SnapConnectorToConnector(NewConn, RaiseConn)
else
SnapConnectorToPointObject(NewConn, RaiseConn);
AutoConnectOverRaiseInCAD(AConnector, RaiseConn); //#From Oleg#
//AutoDisconnectOverRaiseInCAD(AConnector, RaiseConn, RaiseLine); //#From Oleg#
end
else
// èçìåíèòü âûñîòó -------------------------------------------------------
begin
// óñòàíîâèòü íîâûå çíà÷åíèÿ
AConnector.ActualZOrder[1] := AHeight;
SetConFigureCoordZInPM(AConnector.ID, AConnector.ActualZOrder[1]);
SetConnBringToFront(AConnector);
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := AConnector.JoinedOrtholinesList[i];
if JoinedLine.JoinConnector1 = AConnector then
begin
SetLineFigureCoordZInPM(JoinedLine.ID, 1, AConnector.ActualZOrder[1]);
JoinedLine.ActualZOrder[1] := AConnector.ActualZOrder[1];
end;
if JoinedLine.JoinConnector2 = AConnector then
begin
SetLineFigureCoordZInPM(JoinedLine.ID, 2, AConnector.ActualZOrder[1]);
JoinedLine.ActualZOrder[2] := AConnector.ActualZOrder[1];
end;
JoinedLine.CalculLength := JoinedLine.LengthCalc;
JoinedLine.LineLength := JoinedLine.CalculLength;
SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength);
// Îáíîâèòü ïîëå äëèííû äëÿ îðòîëèíèè
JoinedLine.UpdateLengthTextBox(false, true);
end;
// ïîäúåì-ñïóñê
RaiseLine.FLineRaiseType := GetRaiseType(AConnector, RaiseConn);
// RaiseLine.ReCreateCaptionsGroup(True, false);
RaiseLine.UpdateLengthTextBox(True, true);
RaiseLine.ReCreateNotesGroup(True);
SetConFigureCoordZInPM(AConnector.ID, AHeight);
end;
end
else
{************* ÎÁÚÅÊÒ *****************************************************}
begin
PointObject := TConnectorObject(AConnector.JoinedConnectorsList[0]);
RaiseConn := GetRaiseConn(PointObject);
if RaiseConn <> nil then
RaiseLine := GetRaiseLine(RaiseConn);
// óñòàíîâèòü íîâûå çíà÷åíèÿ
PointObject.ActualZOrder[1] := AHeight;
SetConFigureCoordZInPM(PointObject.ID, PointObject.ActualZOrder[1]);
// ñîâïàäàåò ñ ñ-ï, óäàëèòü ñ-ï
if RaiseConn.ActualZOrder[1] = AHeight then
begin
AutoDisconnectOverRaiseInCAD(AConnector, RaiseConn, RaiseLine); //#From Oleg#
UnSnapConnectorFrompointObject(AConnector, PointObject);
if RaiseConn.ConnectorType = ct_Clear then
SnapConnectorToConnector(AConnector, RaiseConn)
else
SnapConnectorToPointObject(AConnector, RaiseConn);
end
else
// èçìåíèòü âûñîòó
begin
SetConnBringToFront(PointObject);
for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := PointObject.JoinedConnectorsList[i];
JoinedConn.ActualZOrder[1] := PointObject.ActualZOrder[1];
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := JoinedConn.JoinedOrtholinesList[j];
if JoinedLine.JoinConnector1 = JoinedConn then
begin
SetLineFigureCoordZInPM(JoinedLine.ID, 1, PointObject.ActualZOrder[1]);
JoinedLine.ActualZOrder[1] := PointObject.ActualZOrder[1];
end;
if JoinedLine.JoinConnector2 = JoinedConn then
begin
SetLineFigureCoordZInPM(JoinedLine.ID, 2, PointObject.ActualZOrder[1]);
JoinedLine.ActualZOrder[2] := PointObject.ActualZOrder[1];
end;
end;
SetConFigureCoordZInPM(JoinedConn.ID, JoinedConn.ActualZOrder[1]);
if JoinedLine <> nil then //#From Oleg#
begin
JoinedLine.CalculLength := JoinedLine.LengthCalc;
JoinedLine.LineLength := JoinedLine.CalculLength;
SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength);
// Îáíîâèòü ïîëå äëèííû äëÿ îðòîëèíèè
JoinedLine.UpdateLengthTextBox(false, true);
end;
end;
// ïîäúåì-ñïóñê
RaiseLine.FLineRaiseType := GetRaiseType(PointObject, RaiseConn);
// RaiseLine.ReCreateCaptionsGroup(True, false);
RaiseLine.UpdateLengthTextBox(True, true);
RaiseLine.ReCreateNotesGroup(True);
SetConFigureCoordZInPM(PointObject.ID, AHeight);
end;
end;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.ChangeRaiseOnNextObject', E.Message);
end;
BaseEndUpdate;
end;
// ÓÄÀËÈÒÜ Ñ-Ï ÍÀ ÎÁÚÅÊÒÅ
procedure DestroyRaiseOnPointObject(APointObject: TConnectorObject);
var
i, j: integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
ObjParams: TObjectParams;
begin
BaseBeginUpdate;
try
RaiseLine := nil; //#From Oleg#
RaiseConn := GetRaiseConn(APointObject);
if RaiseConn <> nil then
RaiseLine := GetRaiseLine(RaiseConn);
if (RaiseLine <> nil) and (not RaiseLine.Deleted) then
begin
AutoDisconnectOverRaiseInCAD(APointObject, RaiseConn, RaiseLine); //#FROM Oleg#
TOrthoLine(RaiseLine).Delete;
RefreshCAD(GCadForm.PCad);
end;
if (RaiseConn <> nil) and (not RaiseConn.Deleted) then
begin
if RaiseConn.JoinedOrtholinesList.Count > 0 then
begin
if RaiseConn.ConnectorType = ct_Clear then
begin
SnapConnectorToPointObject(RaiseConn, APointObject, true);
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;
APointObject.FConnRaiseType := crt_None;
APointObject.FObjectFromRaise := nil;
APointObject.LockMove := False;
APointObject.LockModify := False;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.DestroyRaiseOnPointObject', E.Message);
end;
BaseEndUpdate;
end;
// ÓÄÀËÈÒÜ Ñ-Ï ÍÀ ÑÎÅÄÈÍÈÒÅËÅ
Procedure DestroyRaiseOnConnector(AConnector: TConnectorObject);
var
i, j: integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
ObjParams: TObjectParams;
begin
BaseBeginUpdate;
try
RaiseLine := nil; //#From Oleg#
RaiseConn := GetRaiseConn(AConnector);
if RaiseConn <> nil then
RaiseLine := GetRaiseLine(RaiseConn);
if (RaiseLine <> nil) and (not RaiseLine.Deleted) then
begin
AutoDisconnectOverRaiseInCAD(AConnector, RaiseConn, RaiseLine); //#From Oleg#
TOrthoLine(RaiseLine).Delete;
RefreshCAD(GCadForm.PCad);
end;
if (RaiseConn <> nil) and (not RaiseConn.Deleted) then
begin
if RaiseConn.ConnectorType = ct_clear then
begin
// SnapConnectorToConnector(RaiseConn, AConnector, true);
SnapConnectorToConnector(AConnector, RaiseConn, true);
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;
if (AConnector <> nil) and (not AConnector.Deleted) then
begin
AConnector.FConnRaiseType := crt_None;
AConnector.FObjectFromRaise := nil;
AConnector.LockMove := False;
AConnector.LockModify := False;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.DestroyRaiseOnConnector', E.Message);
end;
BaseEndUpdate;
end;
// ÏÎÄÍßÒÜ ËÈÍÈÞ ÍÀ ÂÛÑÎÒÓ
Procedure RaiseLineOnHeight(ALine: TOrthoLine; AHeight: Double; ATracesList: TList);
var
Connector1: TConnectorObject;
Connector2: TConnectorObject;
RT1: TConnectorObject;
RT2: TConnectorObject;
RaiseConn: TConnectorObject;
ObjFromRaise: TConnectorObject;
begin
BaseBeginUpdate;
try
Connector1 := TConnectorObject(ALine.JoinConnector1);
Connector2 := TConnectorObject(ALine.JoinConnector2);
// 1
if Connector1.ActualZOrder[1] <> AHeight then
begin
// íå âåðøèíà ñ-ï è íà íåì íåò ñ-ï
if (Connector1.FConnRaiseType = crt_None) and (GetRaiseConn(Connector1) = nil) then
begin
if (Connector1.JoinedConnectorsList.Count > 0) or (Connector1.JoinedOrtholinesList.Count > 1) then
begin
// Conn
if (Connector1.ConnectorType = ct_Clear) and (Connector1.JoinedOrtholinesList.Count > 1) then
begin
if CheckNeedCreateRaiseOnRaiseTrace(ALine, Connector1, ATracesList) then
CreateRaiseOnNextObject(Connector1, ALine, AHeight)
else
begin
Connector1.ActualZOrder[1] := AHeight;
SetConFigureCoordZInPM(Connector1.ID, Connector1.ActualZOrder[1]);//24.10.2012
ALine.ActualZOrder[1] := AHeight;
end;
end
else
// RT
begin
//
RT1 := TConnectorObject(Connector1.JoinedConnectorsList[0]);
RaiseConn := GetRaiseConn(RT1);
// íå âåðøèíà ñ-ï è íåò ñ-ï
if (RT1.FConnRaiseType = crt_None) and (RaiseConn = nil) then
CreateRaiseOnNextObject(Connector1, ALine, AHeight)
else
begin
// åñòü ñ-ï è îí ìåæýòàæíûé
if (RaiseConn <> nil) and (RaiseConn.FConnRaiseType <> crt_OnFloor) then
begin
ChangeRaiseOnNextObject(Connector1, ALine, AHeight);
end
else
if (RaiseConn = nil) and (ObjFromRaise <> nil) then
begin
RT1.ActualZOrder[1] := AHeight;
SetConFigureCoordZInPM(RT1.ID, RT1.ActualZOrder[1]); //24.10.2012
Connector1.ActualZOrder[1] := AHeight;
ALine.ActualZOrder[1] := AHeight;
end
else
begin
CreateRaiseOnNextObject(Connector1, ALine, AHeight);
end;
end;
end;
end
else
begin
Connector1.ActualZOrder[1] := AHeight;
SetConFigureCoordZInPM(Connector1.ID, Connector1.ActualZOrder[1]);//24.10.2012
ALine.ActualZOrder[1] := AHeight;
end;
end
else
// ýòî âåðøèíà ñ-ï èëè íå íåì åñòü ñ-ï
begin
if (Connector1.FConnRaiseType <> crt_BetweenFloorUp) and (Connector1.FConnRaiseType <> crt_BetweenFloorDown) then
ChangeRaiseOnNextObject(Connector1, ALine, AHeight);
end;
end;
// 2
if Connector2.ActualZOrder[1] <> AHeight then
begin
// íå âåðøèíà ñ-ï è íà íåì íåò ñ-ï
if (Connector2.FConnRaiseType = crt_None) and (GetRaiseConn(Connector2) = nil) then
begin
if (Connector2.JoinedConnectorsList.Count > 0) or (Connector2.JoinedOrtholinesList.Count > 1) then
begin
// RT
if (Connector2.ConnectorType = ct_Clear) and (Connector2.JoinedOrtholinesList.Count > 1) then
begin
if CheckNeedCreateRaiseOnRaiseTrace(ALine, Connector2, ATracesList) then
CreateRaiseOnNextObject(Connector2, ALine, AHeight)
else
begin
Connector2.ActualZOrder[1] := AHeight;
SetConFigureCoordZInPM(Connector2.ID, Connector2.ActualZOrder[1]);//24.10.2012
ALine.ActualZOrder[2] := AHeight;
end;
end
else
begin
//
RT2 := TConnectorObject(Connector2.JoinedConnectorsList[0]);
RaiseConn := GetRaiseConn(RT2);
// íå âåðøèíà ñ-ï è íåò ñ-ï
if (RT2.FConnRaiseType = crt_None) and (RaiseConn = nil) then
CreateRaiseOnNextObject(Connector2, ALine, AHeight)
else
begin
if (RaiseConn <> nil) and (RaiseConn.FConnRaiseType <> crt_OnFloor) then
begin
ChangeRaiseOnNextObject(Connector2, ALine, AHeight);
end
else
if (RaiseConn = nil) and (ObjFromRaise <> nil) then
begin
RT2.ActualZOrder[1] := AHeight;
SetConFigureCoordZInPM(RT2.ID, RT2.ActualZOrder[1]);
Connector1.ActualZOrder[2] := AHeight;
ALine.ActualZOrder[2] := AHeight;
end
else
begin
CreateRaiseOnNextObject(Connector2, ALine, AHeight);
end;
end;
end;
end
else
begin
Connector2.ActualZOrder[1] := AHeight;
SetConFigureCoordZInPM(Connector2.ID, Connector2.ActualZOrder[1]); //24.10.2012
ALine.ActualZOrder[2] := AHeight;
end;
end
else
// ýòî âåðøèíà ñ-ï èëè íå íåì åñòü ñ-ï
begin
if (Connector2.FConnRaiseType <> crt_BetweenFloorUp) and (Connector2.FConnRaiseType <> crt_BetweenFloorDown) then
ChangeRaiseOnNextObject(Connector2, ALine, AHeight);
end;
end;
ALine.CalculLength := ALine.LengthCalc;
ALine.LineLength := ALine.CalculLength;
ALine.UpdateLengthTextBox(False, True);
SetLineFigureCoordZInPM(ALine.ID, 1, ALine.ActualZOrder[1]);
SetLineFigureCoordZInPM(ALine.ID, 2, ALine.ActualZOrder[2]);
AutoDivideLine(ALine); //31.01.2011 - ðàçäåëÿåì ëèíèþ åñëè íóæíî
except
on E: Exception do addExceptionToLogEx('U_Common.RaiseLineOnHeight', E.Message);
end;
BaseEndUpdate;
end;
Function CheckNeedCreateRaiseOnRaiseTrace(ALine: TOrthoLine; AJoinedConn: TConnectorObject; ATracesList: TList): Boolean;
var
i: integer;
CurrLine: TOrthoLine;
begin
Result := False; //#From Oleg#
try
for i := 0 to AJoinedConn.JoinedOrtholinesList.Count - 1 do
begin
CurrLine := TOrthoLine(AJoinedConn.JoinedOrtholinesList[i]);
if CurrLine <> ALine then
begin
if CheckNoFigureinList(CurrLine, ATracesList) then
begin
Result := True;
Break;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckNeedCreateRaiseOnRaiseTrace', E.Message);
end;
end;
Function CreateBetweenFloorRaiseOnPointObject(APointObject: TConnectorObject; ARaiseType: TLineRaiseType): TConnectorObject;
var
ConnectedConn: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
x, y, z: double;
i: integer;
RaiseLineZ: Double;
RaiseConnZ: Double;
ObjParams: TObjectParams;
begin
Result := nil;
BaseBeginUpdate;
try
x := APointObject.ActualPoints[1].x;
y := APointObject.ActualPoints[1].y;
z := APointObject.ActualZOrder[1];
RaiseConnZ := 0; //#From Oleg#
if ARaiseType = lrt_Up then
RaiseConnZ := GCadForm.FRoomHeight;
if ARaiseType = lrt_Down then
RaiseConnZ := 0;
// ñîçäàòü ïðèñîåäèíåííûé êîííåêòîð
ConnectedConn := TConnectorObject.Create(x, y, z, APointObject.LayerHandle, mydsNormal, GCadForm.PCad);
ConnectedConn.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), ConnectedConn, False);
ConnectedConn.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name);
ObjParams := GetFigureParams(ConnectedConn.ID);
ConnectedConn.Name := ObjParams.Name;
ConnectedConn.FIndex := ObjParams.MarkID;
for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do
TConnectorObject(APointObject.JoinedConnectorsList[i]).ActualZOrder[1] := APointObject.ActualZOrder[1];
SetConFigureCoordZInPM(APointObject.ID, APointObject.ActualZOrder[1]);
// ñîçäàòü ïîäúåì-ñïóñê êîííåêòîð
RaiseConn := TConnectorObject.Create(x + 10, y - 10, RaiseConnZ, APointObject.LayerHandle, mydsNormal, GCadForm.PCad);
RaiseConn.ConnectorType := ct_Clear;
// ñîçäàòü ïîäúåì-ñïóñê ëèíèÿ
RaiseLine := TOrthoLine.Create(x, y, z, x + 10, y - 10, RaiseConnZ, 1,ord(psSolid), clBlack, 0,
APointObject.LayerHandle, mydsNormal, GCadForm.PCad, False);
RaiseLine.SetJConnector1(TConnectorObject(ConnectedConn));
RaiseLine.SetJConnector2(TConnectorObject(RaiseConn));
RaiseLine.ActualZOrder[1] := ConnectedConn.ActualZOrder[1];
RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];
SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]);
SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]);
// ïðèêîííåêòèòü ïîäúåì
SnapConnectorToPointObject(ConnectedConn, APointObject);
RaiseConn.MoveConnector(-10, 10, False);
// ÑÎÇÄÀÒÜ ÍÀ ÊÀÄ ===========================================
GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseConn, False);
RaiseConn.Name := cCadClasses_Mes26;
SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name);
ObjParams := GetFigureParams(RaiseConn.ID);
RaiseConn.Name := ObjParams.Name;
RaiseConn.FIndex := ObjParams.MarkID;
GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseLine, False);
RaiseLine.Name := cCadClasses_Mes27;
SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name);
ObjParams := GetFigureParams(RaiseLine.ID);
RaiseLine.Name := ObjParams.Name;
RaiseLine.FIndex := ObjParams.MarkID;
if ARaiseType = lrt_Up then
RaiseConn.FConnRaiseType := crt_BetweenFloorUp;
if ARaiseType = lrt_Down then
RaiseConn.FConnRaiseType := crt_BetweenFloorDown;
RaiseConn.FObjectFromRaise := APointObject;
RaiseLine.FIsRaiseUpDown := True;
RaiseLine.FObjectFromRaisedLine := APointObject;
RaiseLine.FLineRaiseType := ARaiseType;
RaiseLine.CalculLength := RaiseLine.LengthCalc;
RaiseLine.LineLength := RaiseLine.CalculLength;
SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength);
// RaiseLine.ReCreateCaptionsGroup(True, false);
RaiseLine.UpdateLengthTextBox(True, false);
RaiseLine.ReCreateNotesGroup(True);
RaiseConn.LockMove := True;
RaiseConn.LockModify := True;
RaiseLine.LockMove := False;
RaiseLine.LockModify := True;
ConnectedConn.LockMove := True;
ConnectedConn.LockModify := True;
SetConnBringToFront(APointObject);
SetConnBringToFront(RaiseConn);
RefreshCAD(GCadForm.PCad);
Result := RaiseConn;
except
on E: Exception do addExceptionToLogEx('U_Common.CreateBetweenFloorRaiseOnPointObject', E.Message);
end;
BaseEndUpdate;
end;
Function CreateBetweenFloorRaiseOnConnector(AConnector: TConnectorObject; ARaiseType: TLineRaiseType): TConnectorObject;
var
ConnectedConn: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
x, y, z: double;
i: integer;
RaiseConnZ: Double;
RaiseLineZ: Double;
ObjParams: TObjectParams;
begin
Result := nil;
BaseBeginUpdate;
try
x := AConnector.ActualPoints[1].x;
y := AConnector.ActualPoints[1].y;
z := AConnector.ActualZOrder[1];
RaiseConnZ := 0; //#From Oleg#
if ARaiseType = lrt_Up then
RaiseConnZ := GCadForm.FRoomHeight;
if ARaiseType = lrt_Down then
RaiseConnZ := 0;
// ñîçäàòü ïîäúåì-ñïóñê êîííåêòîð
RaiseConn := TConnectorObject.Create(x, y, RaiseConnZ, AConnector.LayerHandle, mydsNormal, GCadForm.PCad);
RaiseConn.ConnectorType := ct_Clear;
// ñîçäàòü ïîäúåì-ñïóñê ëèíèÿ
RaiseLine := TOrthoLine.Create(x, y, z, x, y, RaiseConnZ, 1,ord(psSolid), clBlack, 0,
AConnector.LayerHandle, mydsNormal, GCadForm.PCad, False);
RaiseLine.SetJConnector1(TConnectorObject(AConnector));
RaiseLine.SetJConnector2(TConnectorObject(RaiseConn));
RaiseLine.ActualZOrder[1] := AConnector.ActualZOrder[1];
RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];
SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]);
SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]);
// ÑÎÇÄÀÒÜ ÍÀ ÊÀÄ ===========================================
GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseConn, False);
RaiseConn.Name := cCadClasses_Mes26;
SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name);
ObjParams := GetFigureParams(RaiseConn.ID);
RaiseConn.Name := ObjParams.Name;
RaiseConn.FIndex := ObjParams.MarkID;
GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseLine, False);
RaiseLine.Name := cCadClasses_Mes27;
SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name);
ObjParams := GetFigureParams(RaiseLine.ID);
RaiseLine.Name := ObjParams.Name;
RaiseLine.FIndex := ObjParams.MarkID;
if ARaiseType = lrt_Up then
RaiseConn.FConnRaiseType := crt_BetweenFloorUp;
if ARaiseType = lrt_Down then
RaiseConn.FConnRaiseType := crt_BetweenFloorDown;
RaiseConn.FObjectFromRaise := AConnector;
RaiseLine.FIsRaiseUpDown := True;
RaiseLine.FObjectFromRaisedLine := AConnector;
RaiseLine.FLineRaiseType := ARaiseType;
RaiseLine.CalculLength := RaiseLine.LengthCalc;
RaiseLine.LineLength := RaiseLine.CalculLength;
SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength);
// RaiseLine.ReCreateCaptionsGroup(True, false);
RaiseLine.UpdateLengthTextBox(True, false);
RaiseLine.ReCreateNotesGroup(True);
RaiseConn.LockMove := True;
RaiseConn.LockModify := True;
RaiseLine.LockMove := False;
RaiseLine.LockModify := True;
SetConnBringToFront(AConnector);
SetConnBringToFront(RaiseConn);
Result := RaiseConn;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.CreateBetweenFloorRaiseOnConnector', E.Message);
end;
BaseEndUpdate;
end;
// ñîçäàòü ìàãèñòðàëüíûé ñ-ï íà îáúåêòå
Function CreateTrunkRaiseOnPointObject(APointObject: TConnectorObject; ARaiseType: TLineRaiseType; aTrunkLength: Double): TConnectorObject;
var
ConnectedConn: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
x, y, z: double;
i: integer;
RaiseLineZ: Double;
RaiseConnZ: Double;
ObjParams: TObjectParams;
begin
Result := nil;
BaseBeginUpdate;
try
x := APointObject.ActualPoints[1].x;
y := APointObject.ActualPoints[1].y;
z := APointObject.ActualZOrder[1];
RaiseConnZ := 0; //#From Oleg#
if ARaiseType = lrt_Up then
RaiseConnZ := GCadForm.FRoomHeight;
if ARaiseType = lrt_Down then
RaiseConnZ := 0;
// ñîçäàòü ïðèñîåäèíåííûé êîííåêòîð
ConnectedConn := TConnectorObject.Create(x, y, z, APointObject.LayerHandle, mydsNormal, GCadForm.PCad);
ConnectedConn.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), ConnectedConn, False);
ConnectedConn.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name);
ObjParams := GetFigureParams(ConnectedConn.ID);
ConnectedConn.Name := ObjParams.Name;
ConnectedConn.FIndex := ObjParams.MarkID;
for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do
TConnectorObject(APointObject.JoinedConnectorsList[i]).ActualZOrder[1] := APointObject.ActualZOrder[1];
SetConFigureCoordZInPM(APointObject.ID, APointObject.ActualZOrder[1]);
// ñîçäàòü ïîäúåì-ñïóñê êîííåêòîð
RaiseConn := TConnectorObject.Create(x + 10, y - 10, RaiseConnZ, APointObject.LayerHandle, mydsNormal, GCadForm.PCad);
RaiseConn.ConnectorType := ct_Clear;
// ñîçäàòü ïîäúåì-ñïóñê ëèíèÿ
RaiseLine := TOrthoLine.Create(x, y, z, x + 10, y - 10, RaiseConnZ, 1,ord(psSolid), clBlack, 0,
APointObject.LayerHandle, mydsNormal, GCadForm.PCad, False);
RaiseLine.SetJConnector1(TConnectorObject(ConnectedConn));
RaiseLine.SetJConnector2(TConnectorObject(RaiseConn));
RaiseLine.ActualZOrder[1] := ConnectedConn.ActualZOrder[1];
RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];
SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]);
SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]);
// ïðèêîííåêòèòü ïîäúåì
SnapConnectorToPointObject(ConnectedConn, APointObject);
RaiseConn.MoveConnector(-10, 10, False);
// ÑÎÇÄÀÒÜ ÍÀ ÊÀÄ ===========================================
GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseConn, False);
RaiseConn.Name := cCadClasses_Mes30;
SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name);
ObjParams := GetFigureParams(RaiseConn.ID);
RaiseConn.Name := ObjParams.Name;
RaiseConn.FIndex := ObjParams.MarkID;
GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseLine, False);
RaiseLine.Name := cCadClasses_Mes31;
SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name);
ObjParams := GetFigureParams(RaiseLine.ID);
RaiseLine.Name := ObjParams.Name;
RaiseLine.FIndex := ObjParams.MarkID;
if ARaiseType = lrt_Up then
RaiseConn.FConnRaiseType := crt_TrunkUp;
if ARaiseType = lrt_Down then
RaiseConn.FConnRaiseType := crt_TrunkDown;
RaiseConn.FObjectFromRaise := APointObject;
RaiseLine.FIsRaiseUpDown := True;
RaiseLine.FObjectFromRaisedLine := APointObject;
RaiseLine.FLineRaiseType := ARaiseType;
// LENGTH !!!
RaiseLine.CalculLength := RaiseLine.LengthCalc;
// RaiseLine.LineLength := RaiseLine.CalculLength + aAddTrunkLength;
RaiseLine.LineLength := aTrunkLength;
RaiseLine.UserLength := aTrunkLength;
SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength);
RaiseLine.UpdateLengthTextBox(True, false);
RaiseLine.ReCreateNotesGroup(True);
RaiseConn.LockMove := True;
RaiseConn.LockModify := True;
RaiseLine.LockMove := False;
RaiseLine.LockModify := True;
ConnectedConn.LockMove := True;
ConnectedConn.LockModify := True;
SetConnBringToFront(APointObject);
SetConnBringToFront(RaiseConn);
RefreshCAD(GCadForm.PCad);
Result := RaiseConn;
except
on E: Exception do AddExceptionToLogEx('U_Common.CreateTrunkRaiseOnPointObject', E.Message);
end;
BaseEndUpdate;
end;
// ñîçäàòü ìàãèñòðàëüíûé ñ-ï íà êîííåêòîðå
Function CreateTrunkRaiseOnConnector(AConnector: TConnectorObject; ARaiseType: TLineRaiseType; aTrunkLength: Double): TConnectorObject;
var
ConnectedConn: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
x, y, z: double;
i: integer;
RaiseConnZ: Double;
RaiseLineZ: Double;
ObjParams: TObjectParams;
begin
Result := nil;
BaseBeginUpdate;
try
x := AConnector.ActualPoints[1].x;
y := AConnector.ActualPoints[1].y;
z := AConnector.ActualZOrder[1];
RaiseConnZ := 0; //#From Oleg#
if ARaiseType = lrt_Up then
RaiseConnZ := GCadForm.FRoomHeight;
if ARaiseType = lrt_Down then
RaiseConnZ := 0;
// ñîçäàòü ïîäúåì-ñïóñê êîííåêòîð
RaiseConn := TConnectorObject.Create(x, y, RaiseConnZ, AConnector.LayerHandle, mydsNormal, GCadForm.PCad);
RaiseConn.ConnectorType := ct_Clear;
// ñîçäàòü ïîäúåì-ñïóñê ëèíèÿ
RaiseLine := TOrthoLine.Create(x, y, z, x, y, RaiseConnZ, 1,ord(psSolid), clBlack, 0,
AConnector.LayerHandle, mydsNormal, GCadForm.PCad, False);
RaiseLine.SetJConnector1(TConnectorObject(AConnector));
RaiseLine.SetJConnector2(TConnectorObject(RaiseConn));
RaiseLine.ActualZOrder[1] := AConnector.ActualZOrder[1];
RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];
SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]);
SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]);
// ÑÎÇÄÀÒÜ ÍÀ ÊÀÄ ===========================================
GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseConn, False);
RaiseConn.Name := cCadClasses_Mes30;
SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name);
ObjParams := GetFigureParams(RaiseConn.ID);
RaiseConn.Name := ObjParams.Name;
RaiseConn.FIndex := ObjParams.MarkID;
GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseLine, False);
RaiseLine.Name := cCadClasses_Mes31;
SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name);
ObjParams := GetFigureParams(RaiseLine.ID);
RaiseLine.Name := ObjParams.Name;
RaiseLine.FIndex := ObjParams.MarkID;
if ARaiseType = lrt_Up then
RaiseConn.FConnRaiseType := crt_TrunkUp;
if ARaiseType = lrt_Down then
RaiseConn.FConnRaiseType := crt_TrunkDown;
RaiseConn.FObjectFromRaise := AConnector;
RaiseLine.FIsRaiseUpDown := True;
RaiseLine.FObjectFromRaisedLine := AConnector;
RaiseLine.FLineRaiseType := ARaiseType;
// LENGTH !!!
RaiseLine.CalculLength := RaiseLine.LengthCalc;
// RaiseLine.LineLength := RaiseLine.CalculLength + aAddTrunkLength;
RaiseLine.LineLength := aTrunkLength;
RaiseLine.UserLength := aTrunkLength;
SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength);
RaiseLine.UpdateLengthTextBox(True, false);
RaiseLine.ReCreateNotesGroup(True);
RaiseConn.LockMove := True;
RaiseConn.LockModify := True;
RaiseLine.LockMove := False;
RaiseLine.LockModify := True;
SetConnBringToFront(AConnector);
SetConnBringToFront(RaiseConn);
Result := RaiseConn;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do AddExceptionToLogEx('U_Common.CreateTrunkRaiseOnConnector', E.Message);
end;
BaseEndUpdate;
end;
// Ïåðåîòêðûòü ëèñò íà CAD
Procedure ReOpenListInCAD(AListID: Integer; const AListName: string);
var
AddLayer: TLayer;
NewTab: TTabSheet;
MenuItem: TMenuItem;
i, j: integer;
ListStream: TMemoryStream;
//08.09.2011 Buffer: array[0..1023] of Char;
TempPath: string;
ListCaption: string;
fFileName: string;
Figure: TFigure;
ObjIdx: Integer;
ListParams: TListParams;
//Tolik
CadFigList: TList;
//
begin
try
ListParams := GetListParams(AListID);
// ñîçäàòü ëèñò â ïðîåêòå
TF_CAD.Create(FSCS_Main);
GCadForm.FCADListID := AListID; // List ID
GCadForm.FCADListName := AListName; // List name
if AListName = '' then
GCadForm.FCADListName := ListParams.Name;
GCadForm.FCADProjectName := GetCurrProjectName; // Project Name
LoadSettingsForList(AListID, False);
//17.08.2012 ListCaption := GetListParams(GCadForm.FCADListID).Caption;
ListCaption := ListParams.Caption;
SetIsOpenedListInCADToPM(AListID, True);
// Äîáàâèòü ïåðåêëþ÷àòåëü â ïàíåëü ëèñòîâ ïðîåêòà
NewTab := TTabSheet.Create(nil);
NewTab.PageControl := FSCS_Main.pageCADList;
NewTab.Tag := GCadForm.Handle;
NewTab.Caption := ListCaption;
FSCS_Main.pageCADList.ActivePage := NewTab;
// Äîáàâèòü Ëèñòû â ãëàâíîå ìåíþ
for i := 0 to FSCS_Main.mainWindow.Count - 1 do
if FSCS_Main.mainWindow.Items[i].Caption = '-' then
break;
j := 0;
inc(i);
while FSCS_Main.mainWindow.Count > i do
begin
MenuItem := FSCS_Main.mainWindow.Items[FSCS_Main.mainWindow.Count - 1];
FSCS_Main.mainWindow.Delete(FSCS_Main.mainWindow.Count - 1);
MenuItem.Free;
end;
for j := 0 to FSCS_Main.pageCADList.PageCount - 1 do
begin
MenuItem := TMenuItem.Create(nil);
MenuItem.Caption := FSCS_Main.pageCADList.Pages[j].Caption;
MenuItem.Tag := FSCS_Main.pageCADList.Pages[j].Tag;
MenuItem.AutoCheck := True;
MenuItem.RadioItem := True;
MenuItem.Checked := FSCS_Main.pageCADList.Pages[j] = FSCS_Main.pageCADList.ActivePage;
MenuItem.OnClick := FSCS_Main.SwitchWindow;
FSCS_Main.mainWindow.Add(MenuItem);
end;
// ïîäíÿòü Stream ñ ëèñòà
ListStream := GetCadDataFromPM(AListID, fFileName);
if ListStream <> nil then
begin
TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
ListStream.SaveToFile(TempPath + 'tempCAD.pwd');
// ïîäãðóçèòü èç ôàéëà
GCadForm.PCad.OnObjectInserted := Nil;
GCadForm.PCad.LoadFromFile(TempPath + 'tempCAD.pwd');
GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted;
end
else
if fFileName <> '' then
begin
// ïîäãðóçèòü èç ôàéëà
GCadForm.PCad.OnObjectInserted := Nil;
GCadForm.PCad.LoadFromFile(fFileName);
GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted;
end;
if (ListStream <> nil) or (fFileName <> '') then
begin
// äëÿ ñòàðûõ ïðîåêòîâ - ïåðåñîçäàòü ñëîè
if GCadForm.PCad.LayerCount = 7 then
begin
AddLayer := TLayer.Create(cCad_Mes7);
GCadForm.PCad.Layers.Add(Addlayer);
end;
if GCadForm.PCad.LayerCount = 8 then
begin
AddLayer := TLayer.create(cCad_Mes8);
GCadForm.PCad.Layers.Add(AddLayer);
end;
RaiseActiveNet(GCadForm);
if GCadForm.PCad.LayerCount = 9 then
begin
AddLayer := TLayer.create(cCad_Mes29);
GCadForm.PCad.Layers.Add(AddLayer);
end;
{//17.11.2011
GCadForm.FFrameProjectName := nil;
GCadForm.FFrameListName := nil;
GCadForm.FFrameCodeName := nil;
GCadForm.FFrameIndexName := nil;}
GCadForm.ClearFrameFigures;
GNeedReRaiseProperties := False;
//Tolik
CadFigList := TList.Create;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
CadFigList.Add(TFigure(GCadForm.PCad.Figures.Items[i]));
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
Figure := TFigure(GCadForm.PCad.Figures.Items[i]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
TConnectorObject(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTOrthoLine) then
TOrthoLine(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTFrame) then
TFrame(Figure).RaiseProperties
else if CheckFigureByClassName(Figure, cTPlanTrace) then
TPlanTrace(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTPlanObject) then
TPlanObject(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTPlanConnector) then
TPlanConnector(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTCabinet) then
TCabinet(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTCabinetExt) then
TCabinetExt(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, 'TRichText') then
begin
{//17.11.2011
if TRichText(Figure).DataID = 100 then
GCadForm.FFrameProjectName := TRichText(Figure);
if TRichText(Figure).DataID = 200 then
GCadForm.FFrameListName := TRichText(Figure);
if TRichText(Figure).DataID = 300 then
GCadForm.FFrameCodeName := TRichText(Figure);
if TRichText(Figure).DataID = 400 then
GCadForm.FFrameIndexName := TRichText(Figure);}
ObjIdx := GCadForm.FFrameObjects.IndexOf(IntToStr(TRichText(Figure).DataID));
if ObjIdx <> -1 then
GCadForm.FFrameObjects.Objects[ObjIdx] := TRichText(Figure);
end
else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then
TSCSFigureGrp(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTHouse) then
THouse(Figure).RaiseProperties(CadFigList);
end;
//Tolik
// âñå ñäåëàíî íà ðàéçå çà îäèí ïðîõîä
// ïîýòîìó ðåðàéç ïîêà óñòðàíèì
{if GNeedReRaiseProperties then
begin
i := 0;
while i < GCadForm.PCad.FigureCount do
begin
Figure := TFigure(GCadForm.PCad.Figures.Items[i]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
TConnectorObject(Figure).ReRaiseProperties;
end;
if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
TOrthoLine(Figure).ReRaiseProperties;
end;
i := i + 1;
end;
end; }
//Tolik
FreeAndNil(CadFigList);
//
GCadForm.SetFrameFigures;
CorrectStampView;
SetVisibleCabinetsNumbers(GCadForm.FShowCabinetsNumbers);
SetVisibleCabinetsBounds(GCadForm.FShowCabinetsBounds);
FindObjectsForConvertClasses;
SetCADFrameParams(GCadForm);
if GListRaiseWithErrors then
begin
ShowLog;
GListRaiseWithErrors := False;
end;
end;
if ListStream <> nil then
FreeAndNil(ListStream);
GCadForm.WindowState := wsMaximized;
SwitchListInPM(GCadForm.FCADListID, '');
if GCadForm.FListType = lt_Normal then
begin
FSCS_Main.aSetSCSLayer.Execute;
EnableOptionsForNormalList;
end;
if GCadForm.FListType = lt_DesignBox then
begin
FSCS_Main.aSetSubstrateLayer.Execute;
DisableOptionsForDesignList;
end;
if GCadForm.FListType = lt_ProjectPlan then
begin
FSCS_Main.aSetSubstrateLayer.Execute;
DisableOptionsForDesignList;
end;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.ReOpenListInCAD', E.Message);
end;
end;
Procedure ReOpenListInCADIfClosed(AListID: Integer; const AListName: string);
begin
if Not CheckListExist(AListID) then
begin
ProcessMessagesEx;
ReopenListInCAD(AListID, '');
ProcessMessagesEx;
end;
end;
Function CheckListExist(AListID: integer): Boolean;
begin
Result := False;
try
if GetListByID(AListID) <> nil then
Result := True;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckListExist', E.Message);
end;
end;
// ïåðåõîä ïî ïðîåêòàì (âûãðóçêà ñòàðîãî)
Procedure UnloadCurrentProject;
begin
try
FSCS_Main.CloseAll;
except
on E: Exception do addExceptionToLogEx('U_Common.UnloadCurrentProject', E.Message);
end;
end;
// ïåðåõîä ïî ïðîåêòàì (çàãðóçêà íîâîãî)
Procedure LoadNewProject(AListsID: TList; ACurrentListID: Integer);
var
i: integer;
ID: integer;
IDPointer: ^Integer;
LName: string;
FirstListID: Integer;
OldTick, CurrTick: Cardinal;
begin
OldTick := GetTickCount;
try
FirstListID := 0; //#From Oleg#
for i := 0 to AListsID.Count - 1 do
begin
IDPointer := AListsID[i];
ID := IDPointer^;
if i = 0 then
FirstListID := ID;
LName := GetListNameFromPM(ID);
OpenListsInProject(ID, LName);
end;
if GetCurrProjectParams.DefListSetting.SCSType = st_Internal then
FSCS_Main.aMarkingPages.Enabled := True
else
if GetCurrProjectParams.DefListSetting.SCSType = st_External then
FSCS_Main.aMarkingPages.Enabled := False;
if ACurrentListID = - 1 then
SwitchListInCAD(FirstListID, '')
else
SwitchListInCAD(ACurrentListID, '');
except
on E: Exception do addExceptionToLogEx('U_Common.LoadNewProject', E.Message);
end;
CurrTick := GetTickCount - OldTick;
CurrTick := GetTickCount - OldTick;
end;
// ñðàâíåíèå äâóõ ÷èñåë òèïà Double
function DoubleCMP(Double1, Double2: Double): Boolean;
var
String1, String2: string;
begin
Result := false;
try
String1 := FormatFloat('0.00', Double1);
String2 := FormatFloat('0.00', Double2);
Double1 := StrToFloat_My(String1);
Double2 := StrToFloat_My(String2);
if Double1 = Double2 then
Result := True
else
Result := False;
except
on E: Exception do addExceptionToLogEx('U_Common.DoubleCMP', E.Message);
end;
end;
procedure SetConnBringToFront(AConnector: TConnectorObject);
begin
try
GCadForm.PCad.DeselectAll(2);
AConnector.Select;
GCadForm.PCad.RecordUndo := True;
GCadForm.PCad.OrderSelection(osFront);
GCadForm.PCad.RecordUndo := False;
AConnector.Deselect;
except
end;
end;
function GetAllFiguresByClass(ACADForm: TF_CAD; aClass: TClass): TList;
var
i: Integer;
procedure CheckFigure(aFigure: TFigure);
var
i: Integer;
CurrFigure: TFigure;
begin
if aFigure is aClass then
Result.Add(aFigure)
else if aFigure is TFigureGrp then
for i := 0 to TFigureGrp(aFigure).InFigures.Count - 1 do
CheckFigure(TFigure(TFigureGrp(aFigure).InFigures[i]));
end;
begin
Result := TList.Create;
for i := 0 to ACADForm.PCad.FigureCount - 1 do
CheckFigure(TFigure(ACADForm.PCad.Figures[i]));
end;
function GetAllFiguresByClassFromProj(aClass: TClass): TList;
var
i, j: Integer;
List: TForm;
procedure CheckFigure(aFigure: TFigure);
var
i: Integer;
CurrFigure: TFigure;
begin
if aFigure is aClass then
Result.Add(aFigure)
else if aFigure is TFigureGrp then
for i := 0 to TFigureGrp(aFigure).InFigures.Count - 1 do
CheckFigure(TFigure(TFigureGrp(aFigure).InFigures[i]));
end;
begin
Result := TList.Create;
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
List := FSCS_Main.MDIChildren[i];
if List is TF_CAD then
for j := 0 to TF_CAD(List).PCad.FigureCount - 1 do
CheckFigure(TFigure(TF_CAD(List).PCad.Figures[j]));
end;
end;
function GetFigureByID(ACADForm: TF_CAD; AID_Figure: Integer): TFigure;
var
i: integer;
FFigure: TFigure;
FigLayerHandle1: Integer;
FigLayerHandle2: Integer;
begin
Result := nil;
try
if (ACADForm <> nil) and (ACADForm.PCad <> nil) then
begin
Result := TFigure(ACADForm.FSCSFigures.GetObject(AID_Figure));
if Result = nil then
begin
FigLayerHandle1 := ACADForm.PCad.GetLayerHandle(lnSCSCommon);
FigLayerHandle2 := ACADForm.PCad.GetLayerHandle(lnRoom);
for i := 0 to ACadForm.PCad.FigureCount - 1 do
begin
FFigure := TFigure(ACadForm.PCad.Figures[i]);
if (FFigure.LayerHandle = FigLayerHandle1) or (FFigure.LayerHandle = FigLayerHandle2) then
begin
if CheckFigureByClassName(FFigure, cTConnectorObject) or CheckFigureByClassName(FFigure, cTOrthoLine) then
//if CheckFigureByClassIdx(FFigure, ciTConnectorObject) or CheckFigureByClassIdx(FFigure, ciTOrthoLine) then
begin
if FFigure.ID = AID_Figure then
begin
Result := FFigure;
Break;
end;
end
else if CheckFigureByClassName(FFigure, cTCabinet) then
//else if CheckFigureByClassIdx(FFigure, ciTCabinet) then
begin
if TCabinet(FFigure).FSCSID = AID_Figure then
begin
Result := FFigure;
Break;
end;
end
else if CheckFigureByClassName(FFigure, cTCabinetExt) then
//else if CheckFigureByClassIdx(FFigure, ciTCabinetExt) then
begin
if TCabinetExt(FFigure).FSCSID = AID_Figure then
begin
Result := FFigure;
Break;
end;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetFigureByID', E.Message);
end;
end;
function GetFigureByOrign(aFigureList: TList): TFigure;
var
Figure: TFigure;
FigurePointCount: Integer;
MinFigDist: Double;
MinPointDist: Double;
pDist: Double;
i, j: Integer;
begin
Result := nil;
MinFigDist := -1;
for i := 0 to aFigureList.Count - 1 do
begin
Figure := TFigure(aFigureList[i]);
FigurePointCount := Figure.PointCount;
if Figure.ClassName = TConnectorObject.ClassName then
FigurePointCount := 4;
if FigurePointCount > 0 then
begin
MinPointDist := -1;
for j := 1 to FigurePointCount do
begin
pDist := GetLineLenght(Figure.ActualPoints[j], DoublePoint(0,0));
if (MinPointDist = -1) or (pDist < MinPointDist) then
MinPointDist := pDist;
end;
if (MinFigDist = -1) or (MinPointDist < MinFigDist) then
begin
Result := Figure;
MinFigDist := MinPointDist;
end;
end;
end;
end;
function GetFigureByIDProj(AID_Figure: Integer): TFigure;
var
CADForm: TF_CAD;
i: Integer;
begin
Result := nil;
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
CADForm := TF_CAD(FSCS_Main.MDIChildren[i]);
Result := GetFigureByID(CADForm, AID_Figure);
if Result <> nil then
Break; //// BREAK ////
end;
end;
function GetHouseByID(ACADForm: TF_CAD; AID_Figure: Integer): THouse;
var
i: integer;
FFigure: TFigure;
begin
Result := nil;
try
if (ACADForm <> nil) and (ACADForm.PCad <> nil) then
begin
for i := 0 to ACadForm.PCad.FigureCount - 1 do
begin
FFigure := TFigure(ACadForm.PCad.Figures[i]);
if CheckFigureByClassName(FFigure, cTHouse) then
begin
if FFigure.ID = AID_Figure then
begin
Result := THouse(FFigure);
Break;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.GetHouseByID', E.Message);
end;
end;
function GetApproachByComponID(ACADForm: TF_CAD; AID_Compon: Integer): TConnectorObject;
var
i: integer;
FFigure: TFigure;
begin
Result := nil;
try
if (ACADForm <> nil) and (ACADForm.PCad <> nil) then
begin
for i := 0 to ACadForm.PCad.FigureCount - 1 do
begin
FFigure := TFigure(ACadForm.PCad.Figures[i]);
if CheckFigureByClassName(FFigure, cTConnectorObject) and (TConnectorObject(FFigure).FIsApproach) then
begin
if TConnectorObject(FFigure).FComponID = AID_Compon then
begin
Result := TConnectorObject(FFigure);
Break;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
function GetFigureByIDInSCSFigureGroups(ACADForm: TF_CAD; AID_Figure: Integer): TFigure;
var
i, j: integer;
SCSFigureGrp: TSCSFigureGrp;
FFigure: TFigure;
begin
Result := nil;
try
if (ACADForm <> nil) and (ACADForm.PCad <> nil) then
begin
for i := 0 to ACadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(ACadForm.PCad.Figures[i]), cTSCSFigureGrp) then
begin
SCSFigureGrp := TSCSFigureGrp(ACadForm.PCad.Figures[i]);
for j := 0 to SCSFigureGrp.InFigures.Count - 1 do
begin
FFigure := TFigure(SCSFigureGrp.InFigures[j]);
if CheckFigureByClassName(FFigure, cTConnectorObject) or CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
if FFigure.ID = AID_Figure then
begin
Result := FFigure;
Exit;
end;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetFigureByIDInSCSFigureGroups', E.Message);
end;
end;
function GetFigureByIDInSCSFigureGrp(ASCSFigureGrp: TSCSFigureGrp; AID_Figure: Integer): TFigure;
var
i, j: integer;
SCSFigureGrp: TSCSFigureGrp;
FFigure: TFigure;
begin
Result := nil;
try
for i := 0 to ASCSFigureGrp.InFigures.Count - 1 do
begin
FFigure := TFigure(ASCSFigureGrp.InFigures[i]);
if CheckFigureByClassName(FFigure, cTConnectorObject) or CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
if FFigure.ID = AID_Figure then
begin
Result := FFigure;
Exit;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetFigureByIDInSCSFigureGrp', E.Message);
end;
end;
function GetSCSFigureGrp(ACADForm: TF_CAD; AID_Figure: Integer): TSCSFigureGrp;
var
i, j: integer;
SCSFigureGrp: TSCSFigureGrp;
FFigure: TFigure;
begin
Result := nil;
try
if (ACADForm <> nil) and (ACADForm.PCad <> nil) then
begin
for i := 0 to ACadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(ACadForm.PCad.Figures[i]), cTSCSFigureGrp) then
begin
SCSFigureGrp := TSCSFigureGrp(ACadForm.PCad.Figures[i]);
for j := 0 to SCSFigureGrp.InFigures.Count - 1 do
begin
FFigure := TFigure(SCSFigureGrp.InFigures[j]);
if CheckFigureByClassName(FFigure, cTConnectorObject) or CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
if FFigure.ID = AID_Figure then
begin
Result := SCSFigureGrp;
Exit;
end;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetSCSFigureGrp', E.Message);
end;
end;
function GetListByID(AID_List: Integer): TF_CAD;
var
i: integer;
begin
Result := nil;
try
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
if TF_CAD(FSCS_Main.MDIChildren[i]).FCADListID = AID_List then
begin
Result := TF_CAD(FSCS_Main.MDIChildren[i]);
break;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetListByID', E.Message);
end;
end;
Function GetListOfPassage(AListID: Integer): TF_CAD;
begin
Result := nil;
try
Result := GetListByID(AListID);
except
on E: Exception do addExceptionToLogEx('U_Common.GetListOfPassage', E.Message);
end;
end;
// ÏÐÈÂßÇÊÀ ÊÎÍÅÊÒÎÐÀ Ê ÊÎÍÅÊÒÎÐÓ
procedure SnapConnectorToConnector(AConnector, ASnapConnector: TConnectorObject; AOnRaise: Boolean = false);
var
i, j: integer;
NewDeltaX, NewDeltaY: double;
OLine: TOrthoLine;
TempFigure: TFigure;
PrevLine: TOrthoLine;
CurrentLine: TOrthoLine;
SplitFigure: TOrthoLine;
ObjectFromRaise: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
ObjParams: TObjectParams;
JoinedLine: TOrthoLine;
OtherList: TF_CAD;
OtherRaise: TConnectorObject;
//
House: THouse;
HouseIndex: Integer;
begin
try
if AConnector.Deleted or ASnapConnector.Deleted then
Exit;
{// #Oleg Commented#}
if Not AOnRaise then
FindConnectionsInterfaces(AConnector, ASnapConnector);
if AConnector.joinedOrtholinesList.count > 0 then
begin
if (ASnapConnector.ActualZOrder[1]>=TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1])
and(ASnapConnector.ActualZOrder[1]>=TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2]) then
begin
if TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1] < TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2] then
AConnector.ActualZOrder[1] := TOrtholine(AConnector.joinedOrtholinesList[0]).ActualZOrder[1]
else
AConnector.ActualZOrder[1] := TOrtholine(AConnector.joinedOrtholinesList[0]).ActualZOrder[2];
end
else
begin
if TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1] < TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2] then
AConnector.ActualZOrder[1] := TOrtholine(AConnector.joinedOrtholinesList[0]).ActualZOrder[2]
else
AConnector.ActualZOrder[1] := TOrtholine(AConnector.joinedOrtholinesList[0]).ActualZOrder[1];
end;
end
else
AConnector.ActualZOrder[1] := ASnapConnector.ActualZOrder[1];
//Tolik
if AOnRaise then
AConnector.ActualZOrder[1] := ASnapConnector.ActualZOrder[1];
//
AConnector.FConnRaiseType := ASnapConnector.FConnRaiseType;
AConnector.FObjectFromRaise := ASnapConnector.FObjectFromRaise;
AConnector.tmpParentDupID := ASnapConnector.tmpParentDupID;
// House
AConnector.fHouse := ASnapConnector.fHouse;
AConnector.FIsHouseJoined := ASnapConnector.FIsHouseJoined;
if (ASnapConnector.FIsHouseJoined) and (ASnapConnector.fHouse <> nil) then
begin
House := ASnapConnector.fHouse;
HouseIndex := House.fJoined.IndexOf(ASnapConnector);
if HouseIndex <> -1 then
House.fJoined[HouseIndex] := AConnector;
end;
// *****
RaiseConn := GetRaiseConn(ASnapConnector);
if RaiseConn <> nil then
begin
RaiseConn.FObjectFromRaise := AConnector;
RaiseLine := GetRaiseLine(RaiseConn);
if RaiseLine <> nil then
RaiseLine.FObjectFromRaisedLine := AConnector;
end;
if (ASnapConnector.FConnRaiseType = crt_BetweenFloorUp) or (ASnapConnector.FConnRaiseType = crt_BetweenFloorDown) or (ASnapConnector.FConnRaiseType = crt_TrunkUp) or (ASnapConnector.FConnRaiseType = crt_TrunkDown)then
begin
AConnector.FID_ConnToPassage := ASnapConnector.FID_ConnToPassage;
AConnector.FID_ListToPassage := ASnapConnector.FID_ListToPassage;
OtherList := GetListByID(ASnapConnector.FID_ListToPassage);
if OtherList <> nil then
begin
OtherRaise := TConnectorObject(GetFigureByID(OtherList, ASnapConnector.FID_ConnToPassage));
if OtherRaise <> nil then
OtherRaise.FID_ConnToPassage := AConnector.ID;
end;
end;
AConnector.Name := ASnapConnector.Name;
// âû÷èñëåíèå ðàçíèöû â êîîðäèíàòàõ äëÿ ñîåäèíåíèÿ îáüåêòîâ
NewDeltaX := ASnapConnector.ActualPoints[1].x - AConnector.ActualPoints[1].x;
NewDeltaY := ASnapConnector.ActualPoints[1].y - AConnector.ActualPoints[1].y;
AConnector.ActualPoints[1] := DoublePoint(ASnapConnector.ActualPoints[1].x, ASnapConnector.ActualPoints[1].y);
AConnector.DrawFigure.move(NewDeltaX, NewDeltaY);
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
if AConnector = TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector1 then
begin
TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[1] := DoublePoint(
TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[1].x + NewDeltaX,
TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[1].y + NewDeltaY);
end;
if AConnector = TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector2 then
begin
TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[2] := DoublePoint(
TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[2].x + NewDeltaX,
TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[2].y + NewDeltaY);
end;
end;
// ïåðåíàçíà÷àåì ñâÿçè îò îáüåêòà ê êîòîðîìó ïðèñîåäèíèëèñü îáüåêòó êîòîðûé ïðèñîåäèíÿåòñÿ
if (AConnector.ConnectorType = ct_Clear) and (ASnapConnector.ConnectorType <> ct_Clear) then
begin
TConnectorObject(TempFigure) := AConnector;
AConnector := ASnapConnector;
ASnapConnector := TConnectorObject(TempFigure);
end;
for i := 0 to ASnapConnector.JoinedOrtholinesList.Count - 1 do
begin
OLine := TOrthoLine(ASnapConnector.JoinedOrtholinesList[i]);
if OLine.JoinConnector1 = ASnapConnector then
OLine.SetJConnector1(AConnector);
if OLine.JoinConnector2 = ASnapConnector then
OLine.SetJConnector2(AConnector);
end;
SplitFigure := Nil;
ObjectFromRaise := AConnector.FObjectFromRaise;
// åñëè åñòü ñ-ï
if ObjectFromRaise <> nil then
begin
if AConnector.ActualZOrder[1] > ObjectFromRaise.ActualZOrder[1] then
begin
AConnector.Name := cCadClasses_Mes24;
SetNewObjectNameInPM(AConnector.ID, AConnector.Name);
ObjParams := GetFigureParams(AConnector.ID);
AConnector.Name := ObjParams.Name;
AConnector.FIndex := ObjParams.MarkID;
end;
if AConnector.ActualZOrder[1] < ObjectFromRaise.ActualZOrder[1] then
begin
AConnector.Name := cCadClasses_Mes24;
SetNewObjectNameInPM(AConnector.ID, AConnector.Name);
ObjParams := GetFigureParams(AConnector.ID);
AConnector.Name := ObjParams.Name;
AConnector.FIndex := ObjParams.MarkID;
end;
SetConFigureCoordZInPM(AConnector.ID, AConnector.ActualZOrder[1]);
SetNewObjectNameInPM(AConnector.ID, AConnector.Name);
SetConnBringToFront(ObjectFromRaise);
SetConnBringToFront(AConnector);
AConnector.LockMove := True;
AConnector.LockModify := True;
end;
try
ASnapConnector.FConnRaiseType := crt_None;
ASnapConnector.FObjectFromRaise := Nil;
ASnapConnector.Delete(False, False);
except
end;
ReCalcZCoordSnapObjects(AConnector);
// Ïðîòîêîë
GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + AConnector.Name + cCommon_Mes1
+ ASnapConnector.Name + '"');
if GCadForm.PCad.SnapToGrids then
begin
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]);
ReAlignLine(JoinedLine);
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SnapConnectorToConnector', E.Message);
end;
end;
// ÏÐÈÂßÇÊÀ ÊÎÍÅÊÒÎÐÀ Ê ÎÐÒÎËÈÍÈÈ
procedure SnapConnectorToOrtholine(AConnector: TConnectorObject; ASnapLine: TOrtholine);
var
i, j: integer;
NewDeltaX, NewDeltaY: double;
AddLine: TOrthoLine;
NextConnector: TConnectorObject;
Modx, Mody, Modz, NextModx, NextMody, NextModz: Double;
TempFigure: TFigure;
TempDefaultNum: integer;
CurrentLine: TOrthoLine;
SplitFigure: TOrthoLine;
CP_Line: TDoublePoint;
AngleRad: Double;
SnapLine: TOrthoLine;
//
Koef: Double;
DeltaHeight: Double;
AllLengthXY: Double;
CurrLengthXY: Double;
MustRealign: Boolean;
JoinedConn: TConnectorObject;
SplitFiguresList: TList;
ObjToDisconnect: TList;
GetOtherConn: TConnectorObject;
begin
try
GetOtherConn := nil; //#From Oleg#
// ïîëó÷èòü ëèñò ñ ïðèñîåäèíåííûìè îáúåêòàìè ñòîðîíû 2
JoinedConn := TConnectorObject(ASnapLine.JoinConnector2);
ObjToDisconnect := TList.Create;
if JoinedConn.JoinedConnectorsList.Count > 0 then
ObjToDisconnect.Add(JoinedConn.JoinedConnectorsList[0])
else
begin
for i := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(JoinedConn.JoinedOrtholinesList[i]) <> ASnapLine then
ObjToDisconnect.Add(JoinedConn.JoinedOrtholinesList[i]);
end;
{--------------------------------------------------------------}
DeltaHeight := ASnapLine.ActualZOrder[2] - ASnapLine.ActualZOrder[1];
AllLengthXY := SQRT(SQR(ASnapLine.ActualPoints[1].x - ASnapLine.ActualPoints[2].x) +
SQR(ASnapLine.ActualPoints[1].y - ASnapLine.ActualPoints[2].y));
AngleRad := GetLineAngle(ASnapLine.ActualPoints[1], ASnapLine.ActualPoints[2]);
if GCadForm.PCad.SnapToGrids then
begin
if (AngleRad = 0) or (AngleRad = 90) or (AngleRad = 180) or (AngleRad = 270) or (AngleRad = 360) then
MustRealign := true
else
MustRealign := false;
end
else
MustRealign := false;
SplitFiguresList := TList.Create;
NextConnector := TConnectorObject(ASnapLine.JoinConnector2);
if ASnapLine.ActualPoints[1].x = ASnapLine.ActualPoints[2].x then
begin
NewDeltaY := 0;
NewDeltaX := ASnapLine.ActualPoints[1].x - AConnector.ActualPoints[1].x;
AConnector.ActualPoints[1] := DoublePoint(AConnector.ActualPoints[1].x + NewDeltaX, AConnector.ActualPoints[1].y);
end
else
if ASnapLine.ActualPoints[1].y = ASnapLine.ActualPoints[2].y then
begin
NewDeltaX := 0;
NewDeltaY := ASnapLine.ActualPoints[1].y - AConnector.ActualPoints[1].y;
AConnector.ActualPoints[1] := DoublePoint(AConnector.ActualPoints[1].x, AConnector.ActualPoints[1].y + NewDeltaY);
end
else
begin
NewDeltaX := 0;
NewDeltaY := 0;
AConnector.ActualPoints[1] := DoublePoint(AConnector.ActualPoints[1].x + NewDeltaX, AConnector.ActualPoints[1].y + NewDeltaY);
end;
AConnector.DrawFigure.move(NewDeltaX, NewDeltaY);
if AConnector.CaptionsGroup <> nil then
AConnector.CaptionsGroup.Move(NewDeltaX, NewDeltaY);
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
if AConnector = TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector1 then
begin
TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[1] := DoublePoint(
TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[1].x + NewDeltaX,
TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[1].y + NewDeltaY);
end;
if AConnector = TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector2 then
begin
TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[2] := DoublePoint(
TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[2].x + NewDeltaX,
TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[2].y + NewDeltaY);
end;
end;
// âû÷èñëåíèå òî÷åê ìîäèôèêàöèè
Modx := (AConnector.ActualPoints[1].x + AConnector.ActualPoints[2].x) / 2;
Mody := (AConnector.ActualPoints[1].y + AConnector.ActualPoints[2].y) / 2;
Modz := AConnector.ActualZOrder[1];
NextModx := (NextConnector.ActualPoints[1].x + NextConnector.ActualPoints[2].x) / 2;
NextMody := (NextConnector.ActualPoints[1].y + NextConnector.ActualPoints[2].y) / 2;
NextModz := NextConnector.ActualZOrder[1];
// Ïðè ñîåäèíåíèè êîíåêòîðà ñ ëèíèåé, ñîçäàåòñÿ 2 ëèíèè
// ïåðåíàçíà÷åíèå ñâÿçåé ëèíèè ê êîòîðîé ïðèñîåäèíèëèñü íîâîìó êîííåêòîðó
ASnapLine.ActualPoints[2] := DoublePoint(Modx, Mody);
ASnapLine.ActualZOrder[1] := Modz;
ASnapLine.SetJConnector2(AConnector);
TConnectorObject(NextConnector).JoinedOrtholinesList.Remove(ASnapLine);
// äîáàâèòü íîâóþ îðòîëèíèþ
TempDefaultNum := GDefaultNum;
GDefaultNum := ASnapLine.FCount;
GDefaultGap := ASnapLine.FGap;
AddLine := TOrthoLine.Create(Modx, Mody, Modz, NextModx, NextMody, NextModz,
1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad);
GCadForm.PCad.AddCustomFigure (GLN(ASnapLine.LayerHandle), AddLine, false);
GDefaultNum := TempDefaultNum;
// ïðèñâîèòü ñâÿçè íîâîé îðòîëèíèè
AddLine.SetJConnector1(AConnector);
AddLine.SetJConnector2(NextConnector);
// ïðè ñäâîåíèè ëèíèé óäàëèòü FigureSnap
SplitFigure := Nil;
CurrLengthXY := SQRT(SQR(ASnapLine.ActualPoints[1].x - ASnapLine.ActualPoints[2].x) +
SQR(ASnapLine.ActualPoints[1].y - ASnapLine.ActualPoints[2].y));
Koef := CurrLengthXY / AllLengthXY;
AConnector.ActualZOrder[1] := ASnapLine.ActualZOrder[1] + DeltaHeight;
ASnapLine.ActualZOrder[2] := AConnector.ActualZOrder[1];
AddLine.ActualZOrder[1] := AConnector.ActualZOrder[1];
// ïåðåðàñ÷åò äëèíû íîâîé ëèíèè
ASnapLine.CalculLength := ASnapLine.LengthCalc;
ASnapLine.LineLength := ASnapLine.CalculLength;
ASnapLine.UpdateLengthTextBox(false, true);
SetLineFigureLengthInPM(ASnapLine.ID, ASnapLine.LineLength);
// ïåðåäâèíóòü TextBoxesGroup
if ASnapLine.CaptionsGroup <> nil then
begin
CP_Line.x := (ASnapLine.ActualPoints[1].x + ASnapLine.ActualPoints[2].x) / 2;
CP_Line.y := (ASnapLine.ActualPoints[1].y + ASnapLine.ActualPoints[2].y) / 2;
ASnapLine.CaptionsGroup.Move(CP_Line.x - ASnapLine.CaptionsGroup.CenterPoint.x,
CP_Line.y - ASnapLine.CaptionsGroup.CenterPoint.y);
end;
// ïåðåðàñ÷åò äëèíû ñîçäàííîé ëèíèè
AddLine.CalculLength := AddLine.LengthCalc;
AddLine.LineLength := AddLine.CalculLength;
AddLine.UpdateLengthTextBox(false, false);
SetLineFigureLengthInPM(AddLine.ID, AddLine.LineLength);
// ïåðåäâèíóòü TextBoxesGroup
if AddLine.CaptionsGroup <> nil then
begin
CP_Line.x := (AddLine.ActualPoints[1].x + AddLine.ActualPoints[2].x) / 2;
CP_Line.y := (AddLine.ActualPoints[1].y + AddLine.ActualPoints[2].y) / 2;
AddLine.CaptionsGroup.Move(CP_Line.x - AddLine.CaptionsGroup.CenterPoint.x,
CP_Line.y - AddLine.CaptionsGroup.CenterPoint.y);
end;
GFigureSnap := Nil;
// âûðîâíÿòü ëèíèè
if MustRealign then
begin
ReAlignObject(AConnector);
ReAlignLine(ASnapLine);
ReAlignLine(AddLine);
end;
SetConnBringToFront(AConnector);
if SplitFiguresList <> nil then
FreeAndNil(SplitFiguresList);
ReCalcZCoordSnapObjects(AConnector);
// Ïðîòîêîë
GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + AConnector.Name + cCommon_Mes1
+ ASnapLine.Name + '"');
// ïðîäîëæèòü òðàññó íà íîâûé îòðåçîê
if AddLine.JoinConnector1 = AConnector then
begin
GetOtherConn := TConnectorObject(AddLine.JoinConnector2);
if GetOtherConn.JoinedConnectorsList.Count > 0 then
GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]);
end;
if AddLine.JoinConnector2 = AConnector then
begin
GetOtherConn := TConnectorObject(AddLine.JoinConnector1);
if GetOtherConn.JoinedConnectorsList.Count > 0 then
GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]);
end;
AutoConnectOverDivideLine(AConnector, GetOtherConn, ASnapLine, AddLine); //AutoConnectOverDivideLine(GetOtherConn, AConnector, AddLine);
// !!!
AddLine.FTraceColor := ASnapLine.FTraceColor;
AddLine.FTraceStyle := ASnapLine.FTraceStyle;
AddLine.FTraceWidth := ASnapLine.FTraceWidth;
AddLine.FLineType := ASnapLine.FLineType;
AddLine.FDrawFigurePercent := ASnapLine.FDrawFigurePercent;
AddLine.BlockStep := ASnapLine.BlockStep;
AddLine.DrawFigureH := 0;
AddLine.CaptionsGroupH := 0;
ASnapLine.DrawFigureH := 0;
ASnapLine.CaptionsGroupH := 0;
ASnapLine.ReCreateCaptionsGroup(false, false);
ASnapLine.ReCreateNotesGroup;
ASnapLine.ReCreateDrawFigureBlock;
AddLine.ReCreateCaptionsGroup(false, false);
AddLine.ReCreateNotesGroup;
AddLine.ReCreateDrawFigureBlock;
if ObjToDisconnect <> nil then
FreeAndNil(ObjToDisconnect);
AddLine.FTraceColor := ASnapLine.FTraceColor;
AddLine.FTraceStyle := ASnapLine.FTraceStyle;
AddLine.FTraceWidth := ASnapLine.FTraceWidth;
AddLine.FLineType := ASnapLine.FLineType;
AddLine.FDrawFigurePercent := ASnapLine.FDrawFigurePercent;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.SnapConnectorToOrtholine', E.Message);
end;
end;
// êîííåêòîð ê âåðòèêàëüíîé òðàññå
procedure SnapConnectorToVertical(AConnector: TConnectorObject; ASnapLine: TOrtholine);
var
i, j: integer;
AddLine: TOrthoLine;
NextConnector: TConnectorObject;
Modx, Mody, Modz, NextModx, NextMody, NextModz: Double;
TempDefaultNum: integer;
CP_Line: TDoublePoint;
//
DeltaPos: Double;
JoinedConn: TConnectorObject;
ObjToDisconnect: TList;
GetOtherConn: TConnectorObject;
ObjParams: TObjectParams;
begin
try
GetOtherConn := nil; //#From Oleg#
AConnector.MoveConnector(ASnapLine.ActualPoints[1].x - AConnector.ActualPoints[1].x,
ASnapLine.ActualPoints[1].y - AConnector.ActualPoints[1].y, false, true);
// ïîëó÷èòü ëèñò ñ ïðèñîåäèíåííûìè îáúåêòàìè ñòîðîíû 2
JoinedConn := TConnectorObject(ASnapLine.JoinConnector2);
ObjToDisconnect := TList.Create;
if JoinedConn.JoinedConnectorsList.Count > 0 then
ObjToDisconnect.Add(JoinedConn.JoinedConnectorsList[0])
else
begin
for i := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(JoinedConn.JoinedOrtholinesList[i]) <> ASnapLine then
ObjToDisconnect.Add(JoinedConn.JoinedOrtholinesList[i]);
end;
{--------------------------------------------------------------}
if (ASnapLine.ActualZOrder[2] > AConnector.ActualZOrder[1]) and (ASnapLine.ActualZOrder[1] < AConnector.ActualZOrder[1]) then
DeltaPos := AConnector.ActualZOrder[1]
else
DeltaPos := (ASnapLine.ActualZOrder[1] + ASnapLine.ActualZOrder[2]) / 2;
NextConnector := TConnectorObject(ASnapLine.JoinConnector2);
// âû÷èñëåíèå òî÷åê ìîäèôèêàöèè
Modx := AConnector.ActualPoints[1].x;
Mody := AConnector.ActualPoints[1].y;
Modz := AConnector.ActualZOrder[1];
NextModx := NextConnector.ActualPoints[1].x;
NextMody := NextConnector.ActualPoints[1].y;
NextModz := NextConnector.ActualZOrder[1];
// Ïðè ñîåäèíåíèè êîíåêòîðà ñ ëèíèåé, ñîçäàåòñÿ 2 ëèíèè
// ïåðåíàçíà÷åíèå ñâÿçåé ëèíèè ê êîòîðîé ïðèñîåäèíèëèñü íîâîìó êîííåêòîðó
ASnapLine.ActualPoints[2] := DoublePoint(Modx, Mody);
ASnapLine.ActualZOrder[1] := Modz;
ASnapLine.SetJConnector2(AConnector);
TConnectorObject(NextConnector).JoinedOrtholinesList.Remove(ASnapLine);
// äîáàâèòü íîâóþ îðòîëèíèþ
TempDefaultNum := GDefaultNum;
GDefaultNum := ASnapLine.FCount;
GDefaultGap := ASnapLine.FGap;
AddLine := TOrthoLine.Create(Modx, Mody, Modz, NextModx, NextMody, NextModz,
1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad);
GCadForm.PCad.AddCustomFigure (GLN(ASnapLine.LayerHandle), AddLine, false);
AddLine.Name := cCadClasses_Mes32;
SetNewObjectNameInPM(AddLine.ID, AddLine.Name);
ObjParams := GetFigureParams(AddLine.ID);
AddLine.Name := ObjParams.Name;
AddLine.FIndex := ObjParams.MarkID;
AddLine.FIsVertical := True;
GDefaultNum := TempDefaultNum;
// ïðèñâîèòü ñâÿçè íîâîé îðòîëèíèè
AddLine.SetJConnector1(AConnector);
AddLine.SetJConnector2(NextConnector);
AConnector.ActualZOrder[1] := DeltaPos;
ASnapLine.ActualZOrder[2] := AConnector.ActualZOrder[1];
AddLine.ActualZOrder[1] := AConnector.ActualZOrder[1];
// ïåðåðàñ÷åò äëèíû íîâîé ëèíèè
ASnapLine.CalculLength := ASnapLine.LengthCalc;
ASnapLine.LineLength := ASnapLine.CalculLength;
ASnapLine.UpdateLengthTextBox(false, true);
SetLineFigureLengthInPM(ASnapLine.ID, ASnapLine.LineLength);
// ïåðåäâèíóòü TextBoxesGroup
if ASnapLine.CaptionsGroup <> nil then
begin
CP_Line.x := (ASnapLine.ActualPoints[1].x + ASnapLine.ActualPoints[2].x) / 2;
CP_Line.y := (ASnapLine.ActualPoints[1].y + ASnapLine.ActualPoints[2].y) / 2;
ASnapLine.CaptionsGroup.Move(CP_Line.x - ASnapLine.CaptionsGroup.CenterPoint.x,
CP_Line.y - ASnapLine.CaptionsGroup.CenterPoint.y);
end;
// ïåðåðàñ÷åò äëèíû ñîçäàííîé ëèíèè
AddLine.CalculLength := AddLine.LengthCalc;
AddLine.LineLength := AddLine.CalculLength;
AddLine.UpdateLengthTextBox(false, false);
SetLineFigureLengthInPM(AddLine.ID, AddLine.LineLength);
// ïåðåäâèíóòü TextBoxesGroup
if AddLine.CaptionsGroup <> nil then
begin
CP_Line.x := (AddLine.ActualPoints[1].x + AddLine.ActualPoints[2].x) / 2;
CP_Line.y := (AddLine.ActualPoints[1].y + AddLine.ActualPoints[2].y) / 2;
AddLine.CaptionsGroup.Move(CP_Line.x - AddLine.CaptionsGroup.CenterPoint.x,
CP_Line.y - AddLine.CaptionsGroup.CenterPoint.y);
end;
GFigureSnap := Nil;
// âûðîâíÿòü ëèíèè
ReAlignObject(AConnector);
ReAlignLine(ASnapLine);
ReAlignLine(AddLine);
SetConnBringToFront(AConnector);
ReCalcZCoordSnapObjects(AConnector);
// Ïðîòîêîë
GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + AConnector.Name + cCommon_Mes1
+ ASnapLine.Name + '"');
// ïðîäîëæèòü òðàññó íà íîâûé îòðåçîê
if AddLine.JoinConnector1 = AConnector then
begin
GetOtherConn := TConnectorObject(AddLine.JoinConnector2);
if GetOtherConn.JoinedConnectorsList.Count > 0 then
GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]);
end;
if AddLine.JoinConnector2 = AConnector then
begin
GetOtherConn := TConnectorObject(AddLine.JoinConnector1);
if GetOtherConn.JoinedConnectorsList.Count > 0 then
GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]);
end;
AutoConnectOverDivideLine(AConnector, GetOtherConn, ASnapLine, AddLine); //AutoConnectOverDivideLine(GetOtherConn, AConnector, AddLine);
// !!!
AddLine.FTraceColor := ASnapLine.FTraceColor;
AddLine.FTraceStyle := ASnapLine.FTraceStyle;
AddLine.FTraceWidth := ASnapLine.FTraceWidth;
AddLine.FLineType := ASnapLine.FLineType;
AddLine.FDrawFigurePercent := ASnapLine.FDrawFigurePercent;
AddLine.BlockStep := ASnapLine.BlockStep;
AddLine.DrawFigureH := 0;
AddLine.CaptionsGroupH := 0;
ASnapLine.DrawFigureH := 0;
ASnapLine.CaptionsGroupH := 0;
ASnapLine.ReCreateCaptionsGroup(false, false);
ASnapLine.ReCreateNotesGroup;
ASnapLine.ReCreateDrawFigureBlock;
AddLine.ReCreateCaptionsGroup(false, false);
AddLine.ReCreateNotesGroup;
AddLine.ReCreateDrawFigureBlock;
AddLine.ShowCaptions := False;
AddLine.ShowNotes := False;
AddLine.IsShowBlock := False;
AddLine.FIsVertical := True;
if ObjToDisconnect <> nil then
FreeAndNil(ObjToDisconnect);
AddLine.FTraceColor := ASnapLine.FTraceColor;
AddLine.FTraceStyle := ASnapLine.FTraceStyle;
AddLine.FTraceWidth := ASnapLine.FTraceWidth;
AddLine.FLineType := ASnapLine.FLineType;
AddLine.FDrawFigurePercent := ASnapLine.FDrawFigurePercent;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do AddExceptionToLogEx('U_Common.SnapConnectorToVertical', E.Message);
end;
end;
// ÏÐÈÂßÇÊÀ ÎÁÜÅÊÒÀ Ê ËÈÍÈÈ
procedure SnapPointObjectToOrthoLine(APointObject: TConnectorObject; ASnapLine: TOrthoLine);
var
i, j: integer;
NewDeltaX, NewDeltaY: double;
AddLine: TOrthoLine;
JoinedCon: TConnectorObject;
ClearCon1, ClearCon2: TConnectorObject;
NextConnector: TFigure;
Modx, Mody, NextModx, NextMody: Double;
TempDefaultNum: integer;
CurrentLine: TOrthoLine;
CP_Line: TDoublePoint;
MustRealign: Boolean;
AngleRad: double;
//
Koef: Double;
AllLengthXY: Double;
CurrLengthXY: Double;
DeltaHeight: Double;
JoinedConn: TConnectorObject;
ObjToDisconnect: TList;
GetOtherConn: TConnectorObject;
begin
try
if (IsSpecialTraceFigure(ASnapLine)) or (ASnapLine.FIsVertical) then
exit;
GetOtherConn := nil; //#From Oleg#
JoinedConn := TConnectorObject(ASnapLine.JoinConnector2);
ObjToDisconnect := TList.Create;
if JoinedConn.JoinedConnectorsList.Count > 0 then
ObjToDisconnect.Add(JoinedConn.JoinedConnectorsList[0])
else
begin
for i := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(JoinedConn.JoinedOrtholinesList[i]) <> ASnapLine then
ObjToDisconnect.Add(JoinedConn.JoinedOrtholinesList[i]);
end;
DeltaHeight := ASnapLine.ActualZOrder[2] - ASnapLine.ActualZOrder[1];
AllLengthXY := SQRT(SQR(ASnapLine.ActualPoints[1].x - ASnapLine.ActualPoints[2].x) +
SQR(ASnapLine.ActualPoints[1].y - ASnapLine.ActualPoints[2].y));
// âûðàâíèâàòü ëèíèþ?
AngleRad := GetLineAngle(ASnapLine.ActualPoints[1], ASnapLine.ActualPoints[2]);
if GCadForm.PCad.SnapToGrids then
begin
if (AngleRad = 0) or (AngleRad = 90) or (AngleRad = 180) or (AngleRad = 270) or (AngleRad = 360) then
MustRealign := true
else
MustRealign := false;
end
else
MustRealign := false;
NextConnector := ASnapLine.JoinConnector2;
if ASnapLine.ActualPoints[1].x = ASnapLine.ActualPoints[2].x then
begin
NewDeltaY := 0;
NewDeltaX := ASnapLine.ActualPoints[1].x - APointObject.ActualPoints[1].x;
APointObject.ActualPoints[1] := DoublePoint(APointObject.ActualPoints[1].x + NewDeltaX,
APointObject.ActualPoints[1].y);
end
else
if ASnapLine.ActualPoints[1].y = ASnapLine.ActualPoints[2].y then
begin
NewDeltaX := 0;
NewDeltaY := ASnapLine.ActualPoints[1].y - APointObject.ActualPoints[1].y;
APointObject.ActualPoints[1] := DoublePoint(APointObject.ActualPoints[1].x,
APointObject.ActualPoints[1].y + NewDeltaY);
end
else
begin
NewDeltaX := 0;
NewDeltaY := 0;
APointObject.ActualPoints[1] := DoublePoint(APointObject.ActualPoints[1].x + NewDeltaX,
APointObject.ActualPoints[1].y + NewDeltaY);
end;
APointObject.DrawFigure.move(NewDeltaX, NewDeltaY);
if APointObject.CaptionsGroup <> nil then
APointObject.CaptionsGroup.Move(NewDeltaX, NewDeltaY);
for i := 0 to APointObject.JoinedOrtholinesList.Count - 1 do
begin
if APointObject = TOrthoLine(APointObject.JoinedOrtholinesList[i]).JoinConnector1 then
begin
TOrthoLine(APointObject.JoinedOrtholinesList[i]).ActualPoints[1] := DoublePoint(
TOrthoLine(APointObject.JoinedOrtholinesList[i]).ActualPoints[1].x + NewDeltaX,
TOrthoLine(APointObject.JoinedOrtholinesList[i]).ActualPoints[1].y + NewDeltaY);
end;
if APointObject = TOrthoLine(APointObject.JoinedOrtholinesList[i]).JoinConnector2 then
begin
TOrthoLine(APointObject.JoinedOrtholinesList[i]).ActualPoints[2] := DoublePoint(
TOrthoLine(APointObject.JoinedOrtholinesList[i]).ActualPoints[2].x + NewDeltaX,
TOrthoLine(APointObject.JoinedOrtholinesList[i]).ActualPoints[2].y + NewDeltaY);
end;
end;
// âû÷èñëåíèå òî÷åê ìîäèôèêàöèè
Modx := APointObject.ActualPoints[1].x;
Mody := APointObject.ActualPoints[1].y;
NextModx := NextConnector.ActualPoints[1].x;
NextMody := NextConnector.ActualPoints[1].y;
// Ïðè ñîåäèíåíèè êîíåêòîðà ñ ëèíèåé, ñîçäàåòñÿ 2 ëèíèè
// ïåðåíàçíà÷åíèå ñâÿçåé ëèíèè ê êîòîðîé ïðèñîåäèíèëèñü íîâîìó êîííåêòîðó
ASnapLine.ActualPoints[2] := DoublePoint(Modx, Mody);
// äîáàâèòü íîâóþ îðòîëèíèþ
TempDefaultNum := GDefaultNum;
GDefaultNum := ASnapLine.FCount;
GDefaultGap := ASnapLine.FGap;
//Tolik
// AddLine := TOrthoLine.Create(Modx, Mody, ASnapLine.ActualZOrder[2], NextModx, NextMody, ASnapLine.ActualZOrder[2],
// 1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad);
if (TConnectorObject(APointObject).Radius > 10000000) then
begin
if {( (not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) or}
( (TConnectorObject(APointObject).Radius - 11000000) <> 999)
{ )} then
AddLine := TOrthoLine.Create(Modx, Mody, TConnectorObject(APointObject).Radius - 11000000{ASnapLine.ActualZOrder[2]}, NextModx, NextMody, ASnapLine.ActualZOrder[2],
1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad)
else
AddLine := TOrthoLine.Create(Modx, Mody, APointObject.ActualZOrder[1], NextModx, NextMody, ASnapLine.ActualZOrder[2],
1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad);
end
else
begin
// ñ APointObject.ActualZOrder[1] - ñ/ï íåñîçäàñòñÿ
//AddLine := TOrthoLine.Create(Modx, Mody, APointObject.ActualZOrder[1], NextModx, NextMody, ASnapLine.ActualZOrder[2],
// 1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad);
AddLine := TOrthoLine.Create(Modx, Mody, ASnapLine.ActualZOrder[2], NextModx, NextMody, ASnapLine.ActualZOrder[2],
1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad);
end;
//
GCadForm.PCad.AddCustomFigure (GLN(ASnapLine.LayerHandle), AddLine, false);
GDefaultNum := TempDefaultNum;
// ñîçäàòü ïóñòûå êîíåêòîðû
ClearCon1 := TConnectorObject.Create(Modx, Mody, GCadForm.FConnHeight, AddLine.LayerHandle, mydsNormal, GCadForm.PCad);
ClearCon1.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(AddLine.LayerHandle), ClearCon1, false);
ClearCon2 := TConnectorObject.Create(Modx, Mody, GCadForm.FConnHeight, AddLine.LayerHandle, mydsNormal, GCadForm.PCad);
ClearCon2.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(AddLine.LayerHandle), ClearCon2, false);
ASnapLine.SetJConnector2(ClearCon1);
TConnectorObject(NextConnector).JoinedOrtholinesList.Remove(ASnapLine);
// ïðèñâîèòü ñâÿçè íîâîé îðòîëèíèè
AddLine.SetJConnector1(ClearCon2);
AddLine.SetJConnector2(NextConnector);
GTempJoinedLinesConnectors.Clear;
for i := 0 to ClearCon1.JoinedOrtholinesList.Count - 1 do
begin
JoinedCon := TConnectorObject(TOrthoLine(ClearCon1.JoinedOrtholinesList[i]).JoinConnector1);
if JoinedCon <> ClearCon1 then
GTempJoinedLinesConnectors.Add(JoinedCon);
JoinedCon := TConnectorObject(TOrthoLine(ClearCon1.JoinedOrtholinesList[i]).JoinConnector2);
if JoinedCon <> ClearCon1 then
GTempJoinedLinesConnectors.Add(JoinedCon);
end;
SnapConnectorToPointObject(ClearCon1, APointObject, False, True);
GTempJoinedLinesConnectors.Clear;
for i := 0 to ClearCon2.JoinedOrtholinesList.Count - 1 do
begin
JoinedCon := TConnectorObject(TOrthoLine(ClearCon2.JoinedOrtholinesList[i]).JoinConnector1);
if JoinedCon <> ClearCon2 then
GTempJoinedLinesConnectors.Add(JoinedCon);
JoinedCon := TConnectorObject(TOrthoLine(ClearCon2.JoinedOrtholinesList[i]).JoinConnector2);
if JoinedCon <> ClearCon2 then
GTempJoinedLinesConnectors.Add(JoinedCon);
end;
SnapConnectorToPointObject(ClearCon2, APointObject, False, True);
CurrLengthXY := SQRT(SQR(ASnapLine.ActualPoints[1].x - ASnapLine.ActualPoints[2].x) +
SQR(ASnapLine.ActualPoints[1].y - ASnapLine.ActualPoints[2].y));
Koef := CurrLengthXY / AllLengthXY;
// Tolik
// APointObject.ActualZOrder[1] := ASnapLine.ActualZOrder[1] + DeltaHeight;
{
if (TConnectorObject(APointObject).Radius > 10000000) then
ÅÑËÈ ÐÀÑÊÎÌÅÍÒÈÒÜ - ó÷åñòü -11000000
if ( (not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) and
( TConnectorObject(APointObject).Radius <> 999)
) then
APointObject.ActualZOrder[1] := ASnapLine.ActualZOrder[1] + DeltaHeight; }
//
if (TConnectorObject(APointObject).Radius > 10000000) then
begin
if (TConnectorObject(APointObject).Radius - 11000000) = 999 then
begin
ClearCon1.ActualZOrder[1] := APointObject.ActualZOrder[1];
ClearCon2.ActualZOrder[1] := APointObject.ActualZOrder[1];
ASnapLine.ActualZOrder[2] := APointObject.ActualZOrder[1];
AddLine.ActualZOrder[1] := APointObject.ActualZOrder[1];
end
else
begin
ClearCon1.ActualZOrder[1] := TConnectorObject(APointObject).Radius - 11000000;
ClearCon2.ActualZOrder[1] := TConnectorObject(APointObject).Radius - 11000000;
ASnapLine.ActualZOrder[2] := TConnectorObject(APointObject).Radius - 11000000;
AddLine.ActualZOrder[1] := TConnectorObject(APointObject).Radius - 11000000;
end;
end
else
begin
APointObject.ActualZOrder[1] := ASnapLine.ActualZOrder[1] + DeltaHeight;
ClearCon1.ActualZOrder[1] := APointObject.ActualZOrder[1];
ClearCon2.ActualZOrder[1] := APointObject.ActualZOrder[1];
ASnapLine.ActualZOrder[2] := APointObject.ActualZOrder[1];
AddLine.ActualZOrder[1] := APointObject.ActualZOrder[1];
end;
// ïåðåðàñ÷åò äëèíû íîâîé ëèíèè
ASnapLine.CalculLength := ASnapLine.LengthCalc;
ASnapLine.LineLength := ASnapLine.CalculLength;
ASnapLine.UpdateLengthTextBox(false, true);
SetLineFigureLengthInPM(ASnapLine.ID, ASnapLine.LineLength);
// ïåðåäâèíóòü TextBoxesGroup
if ASnapLine.CaptionsGroup <> nil then
begin
CP_Line.x := (ASnapLine.ActualPoints[1].x + ASnapLine.ActualPoints[2].x) / 2;
CP_Line.y := (ASnapLine.ActualPoints[1].y + ASnapLine.ActualPoints[2].y) / 2;
ASnapLine.CaptionsGroup.Move(CP_Line.x - ASnapLine.CaptionsGroup.CenterPoint.x,
CP_Line.y - ASnapLine.CaptionsGroup.CenterPoint.y);
end;
// ïåðåðàñ÷åò äëèíû ñîçäàííîé ëèíèè
AddLine.CalculLength := AddLine.LengthCalc;
AddLine.LineLength := AddLine.CalculLength;
AddLine.UpdateLengthTextBox(false, false);
SetLineFigureLengthInPM(AddLine.ID, AddLine.LineLength);
// ïåðåäâèíóòü TextBoxesGroup
if AddLine.CaptionsGroup <> nil then
begin
CP_Line.x := (AddLine.ActualPoints[1].x + AddLine.ActualPoints[2].x) / 2;
CP_Line.y := (AddLine.ActualPoints[1].y + AddLine.ActualPoints[2].y) / 2;
AddLine.CaptionsGroup.Move(CP_Line.x - AddLine.CaptionsGroup.CenterPoint.x,
CP_Line.y - AddLine.CaptionsGroup.CenterPoint.y);
end;
GFigureSnap := Nil;
AutoConnectObjectInTrace(APointObject, ASnapLine, AddLine);
// âûðîâíÿòü ëèíèè
if MustRealign then
begin
ReAlignObject(APointObject);
ReAlignLine(ASnapLine);
ReAlignLine(AddLine);
end;
SetConnBringToFront(APointObject);
ReCalcZCoordSnapObjects(APointObject);
// Ïðîòîêîë
GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + APointObject.Name + cCommon_Mes1
+ ASnapLine.Name + '"');
// ïðîäîëæèòü òðàññó íà íîâûé îòðåçîê
JoinedConn := TConnectorObject(AddLine.JoinConnector1);
if JoinedConn.JoinedConnectorsList.Count > 0 then
begin
if TConnectorObject(JoinedConn.JoinedConnectorsList[0]) = APointObject then
begin
GetOtherConn := TConnectorObject(AddLine.JoinConnector2);
if GetOtherConn.JoinedConnectorsList.Count > 0 then
GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]);
end;
end;
JoinedConn := TConnectorObject(AddLine.JoinConnector2);
if JoinedConn.JoinedConnectorsList.Count > 0 then
begin
if TConnectorObject(JoinedConn.JoinedConnectorsList[0]) = APointObject then
begin
GetOtherConn := TConnectorObject(AddLine.JoinConnector1);
if GetOtherConn.JoinedConnectorsList.Count > 0 then
GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]);
end;
end;
AutoConnectOverDivideLine(APointObject, GetOtherConn, ASnapLine, AddLine); //AutoConnectOverDivideLine(GetOtherConn, APointObject, AddLine);
// !!!
AddLine.FTraceColor := ASnapLine.FTraceColor;
AddLine.FTraceStyle := ASnapLine.FTraceStyle;
AddLine.FTraceWidth := ASnapLine.FTraceWidth;
AddLine.FLineType := ASnapLine.FLineType;
AddLine.FDrawFigurePercent := ASnapLine.FDrawFigurePercent;
AddLine.BlockStep := ASnapLine.BlockStep;
AddLine.DrawFigureH := 0;
AddLine.CaptionsGroupH := 0;
ASnapLine.DrawFigureH := 0;
ASnapLine.CaptionsGroupH := 0;
ASnapLine.ReCreateCaptionsGroup(false, false);
ASnapLine.ReCreateNotesGroup;
ASnapLine.ReCreateDrawFigureBlock;
AddLine.ReCreateCaptionsGroup(false, false);
AddLine.ReCreateNotesGroup;
AddLine.ReCreateDrawFigureBlock;
if ObjToDisconnect <> nil then
FreeAndNil(ObjToDisconnect);
except
on E: Exception do addExceptionToLogEx('U_Common.SnapPointObjectToOrtholine', E.Message);
end;
end;
// îáúåêò ê âåðòèêàëüíîé òðàññå
procedure SnapPointObjectToVertical(APointObject: TConnectorObject; ASnapLine: TOrthoLine);
var
i, j: integer;
NewDeltaX, NewDeltaY: double;
AddLine: TOrthoLine;
JoinedCon: TConnectorObject;
ClearCon1, ClearCon2: TConnectorObject;
NextConnector: TFigure;
Modx, Mody, NextModx, NextMody: Double;
TempDefaultNum: integer;
CurrentLine: TOrthoLine;
CP_Line: TDoublePoint;
DeltaPos: Double;
JoinedConn: TConnectorObject;
ObjToDisconnect: TList;
GetOtherConn: TConnectorObject;
begin
try
GetOtherConn := nil;
APointObject.MoveConnector(ASnapLine.ActualPoints[1].x - APointObject.ActualPoints[1].x,
ASnapLine.ActualPoints[1].y - APointObject.ActualPoints[1].y, false, true);
JoinedConn := TConnectorObject(ASnapLine.JoinConnector2);
ObjToDisconnect := TList.Create;
if JoinedConn.JoinedConnectorsList.Count > 0 then
ObjToDisconnect.Add(JoinedConn.JoinedConnectorsList[0])
else
begin
for i := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(JoinedConn.JoinedOrtholinesList[i]) <> ASnapLine then
ObjToDisconnect.Add(JoinedConn.JoinedOrtholinesList[i]);
end;
if (ASnapLine.ActualZOrder[2] > APointObject.ActualZOrder[1]) and (ASnapLine.ActualZOrder[1] < APointObject.ActualZOrder[1]) then
DeltaPos := APointObject.ActualZOrder[1]
else
DeltaPos := (ASnapLine.ActualZOrder[1] + ASnapLine.ActualZOrder[2]) / 2;
// âûðàâíèâàòü ëèíèþ?
NextConnector := ASnapLine.JoinConnector2;
// âû÷èñëåíèå òî÷åê ìîäèôèêàöèè
Modx := APointObject.ActualPoints[1].x;
Mody := APointObject.ActualPoints[1].y;
NextModx := NextConnector.ActualPoints[1].x;
NextMody := NextConnector.ActualPoints[1].y;
// Ïðè ñîåäèíåíèè êîíåêòîðà ñ ëèíèåé, ñîçäàåòñÿ 2 ëèíèè
// ïåðåíàçíà÷åíèå ñâÿçåé ëèíèè ê êîòîðîé ïðèñîåäèíèëèñü íîâîìó êîííåêòîðó
ASnapLine.ActualPoints[2] := DoublePoint(Modx, Mody);
// äîáàâèòü íîâóþ îðòîëèíèþ
TempDefaultNum := GDefaultNum;
GDefaultNum := ASnapLine.FCount;
GDefaultGap := ASnapLine.FGap;
AddLine := TOrthoLine.Create(Modx, Mody, ASnapLine.ActualZOrder[2], NextModx, NextMody, ASnapLine.ActualZOrder[2],
1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad);
GCadForm.PCad.AddCustomFigure (GLN(ASnapLine.LayerHandle), AddLine, false);
GDefaultNum := TempDefaultNum;
// ñîçäàòü ïóñòûå êîíåêòîðû
ClearCon1 := TConnectorObject.Create(Modx, Mody, GCadForm.FConnHeight, AddLine.LayerHandle, mydsNormal, GCadForm.PCad);
ClearCon1.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(AddLine.LayerHandle), ClearCon1, false);
ClearCon2 := TConnectorObject.Create(Modx, Mody, GCadForm.FConnHeight, AddLine.LayerHandle, mydsNormal, GCadForm.PCad);
ClearCon2.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(AddLine.LayerHandle), ClearCon2, false);
ASnapLine.SetJConnector2(ClearCon1);
TConnectorObject(NextConnector).JoinedOrtholinesList.Remove(ASnapLine);
// ïðèñâîèòü ñâÿçè íîâîé îðòîëèíèè
AddLine.SetJConnector1(ClearCon2);
AddLine.SetJConnector2(NextConnector);
GTempJoinedLinesConnectors.Clear;
for i := 0 to ClearCon1.JoinedOrtholinesList.Count - 1 do
begin
JoinedCon := TConnectorObject(TOrthoLine(ClearCon1.JoinedOrtholinesList[i]).JoinConnector1);
if JoinedCon <> ClearCon1 then
GTempJoinedLinesConnectors.Add(JoinedCon);
JoinedCon := TConnectorObject(TOrthoLine(ClearCon1.JoinedOrtholinesList[i]).JoinConnector2);
if JoinedCon <> ClearCon1 then
GTempJoinedLinesConnectors.Add(JoinedCon);
end;
SnapConnectorToPointObject(ClearCon1, APointObject);
GTempJoinedLinesConnectors.Clear;
for i := 0 to ClearCon2.JoinedOrtholinesList.Count - 1 do
begin
JoinedCon := TConnectorObject(TOrthoLine(ClearCon2.JoinedOrtholinesList[i]).JoinConnector1);
if JoinedCon <> ClearCon2 then
GTempJoinedLinesConnectors.Add(JoinedCon);
JoinedCon := TConnectorObject(TOrthoLine(ClearCon2.JoinedOrtholinesList[i]).JoinConnector2);
if JoinedCon <> ClearCon2 then
GTempJoinedLinesConnectors.Add(JoinedCon);
end;
SnapConnectorToPointObject(ClearCon2, APointObject);
APointObject.ActualZOrder[1] := DeltaPos;
ClearCon1.ActualZOrder[1] := APointObject.ActualZOrder[1];
ClearCon2.ActualZOrder[1] := APointObject.ActualZOrder[1];
ASnapLine.ActualZOrder[2] := APointObject.ActualZOrder[1];
AddLine.ActualZOrder[1] := APointObject.ActualZOrder[1];
// ïåðåðàñ÷åò äëèíû íîâîé ëèíèè
ASnapLine.CalculLength := ASnapLine.LengthCalc;
ASnapLine.LineLength := ASnapLine.CalculLength;
ASnapLine.UpdateLengthTextBox(false, true);
SetLineFigureLengthInPM(ASnapLine.ID, ASnapLine.LineLength);
// ïåðåäâèíóòü TextBoxesGroup
if ASnapLine.CaptionsGroup <> nil then
begin
CP_Line.x := (ASnapLine.ActualPoints[1].x + ASnapLine.ActualPoints[2].x) / 2;
CP_Line.y := (ASnapLine.ActualPoints[1].y + ASnapLine.ActualPoints[2].y) / 2;
ASnapLine.CaptionsGroup.Move(CP_Line.x - ASnapLine.CaptionsGroup.CenterPoint.x,
CP_Line.y - ASnapLine.CaptionsGroup.CenterPoint.y);
end;
// ïåðåðàñ÷åò äëèíû ñîçäàííîé ëèíèè
AddLine.CalculLength := AddLine.LengthCalc;
AddLine.LineLength := AddLine.CalculLength;
AddLine.UpdateLengthTextBox(false, false);
SetLineFigureLengthInPM(AddLine.ID, AddLine.LineLength);
// ïåðåäâèíóòü TextBoxesGroup
if AddLine.CaptionsGroup <> nil then
begin
CP_Line.x := (AddLine.ActualPoints[1].x + AddLine.ActualPoints[2].x) / 2;
CP_Line.y := (AddLine.ActualPoints[1].y + AddLine.ActualPoints[2].y) / 2;
AddLine.CaptionsGroup.Move(CP_Line.x - AddLine.CaptionsGroup.CenterPoint.x,
CP_Line.y - AddLine.CaptionsGroup.CenterPoint.y);
end;
GFigureSnap := Nil;
AutoConnectObjectInTrace(APointObject, ASnapLine, AddLine);
// âûðîâíÿòü ëèíèè
ReAlignObject(APointObject);
ReAlignLine(ASnapLine);
ReAlignLine(AddLine);
SetConnBringToFront(APointObject);
ReCalcZCoordSnapObjects(APointObject);
// Ïðîòîêîë
GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + APointObject.Name + cCommon_Mes1
+ ASnapLine.Name + '"');
// ïðîäîëæèòü òðàññó íà íîâûé îòðåçîê
JoinedConn := TConnectorObject(AddLine.JoinConnector1);
if JoinedConn.JoinedConnectorsList.Count > 0 then
begin
if TConnectorObject(JoinedConn.JoinedConnectorsList[0]) = APointObject then
begin
GetOtherConn := TConnectorObject(AddLine.JoinConnector2);
if GetOtherConn.JoinedConnectorsList.Count > 0 then
GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]);
end;
end;
JoinedConn := TConnectorObject(AddLine.JoinConnector2);
if JoinedConn.JoinedConnectorsList.Count > 0 then
begin
if TConnectorObject(JoinedConn.JoinedConnectorsList[0]) = APointObject then
begin
GetOtherConn := TConnectorObject(AddLine.JoinConnector1);
if GetOtherConn.JoinedConnectorsList.Count > 0 then
GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]);
end;
end;
AutoConnectOverDivideLine(APointObject, GetOtherConn, ASnapLine, AddLine); //AutoConnectOverDivideLine(GetOtherConn, APointObject, AddLine);
// !!!
AddLine.FTraceColor := ASnapLine.FTraceColor;
AddLine.FTraceStyle := ASnapLine.FTraceStyle;
AddLine.FTraceWidth := ASnapLine.FTraceWidth;
AddLine.FLineType := ASnapLine.FLineType;
AddLine.FDrawFigurePercent := ASnapLine.FDrawFigurePercent;
AddLine.BlockStep := ASnapLine.BlockStep;
AddLine.DrawFigureH := 0;
AddLine.CaptionsGroupH := 0;
ASnapLine.DrawFigureH := 0;
ASnapLine.CaptionsGroupH := 0;
ASnapLine.ReCreateCaptionsGroup(false, false);
ASnapLine.ReCreateNotesGroup;
ASnapLine.ReCreateDrawFigureBlock;
AddLine.ReCreateCaptionsGroup(false, false);
AddLine.ReCreateNotesGroup;
AddLine.ReCreateDrawFigureBlock;
AddLine.ShowCaptions := False;
AddLine.ShowNotes := False;
AddLine.IsShowBlock := False;
AddLine.FIsVertical := True;
if ObjToDisconnect <> nil then
FreeAndNil(ObjToDisconnect);
except
on E: Exception do AddExceptionToLogEx('U_Common.SnapPointObjectToVertical', E.Message);
end;
end;
Procedure FillPOintsForConnect(SideConn,APointObject,ConnectedConn: TConnectorObject;
AddDeltaX, AddDeltaY: Double; var Points: TDoublePointArr; var CrossPoints: array of Tdoublepoint);
begin
if (not APointObject.FDrawFigureMoved)and(APointObject.FDrawFigureAngle = 0) then
if not HaveObjectSocketComponent(APointObject.ID) then
begin
CrossPoints[0] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y,
APointObject.ActualPoints[1].x - APointObject.GrpSizeX / 2 + AddDeltaX,
APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY,
APointObject.ActualPoints[1].x - APointObject.GrpSizeX / 2 + AddDeltaX,
APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY);
CrossPoints[1] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y,
APointObject.ActualPoints[1].x - APointObject.GrpSizeX / 2 + AddDeltaX,
APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY,
APointObject.ActualPoints[1].x + APointObject.GrpSizeX / 2 - AddDeltaX,
APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY);
CrossPoints[2] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y,
APointObject.ActualPoints[1].x + APointObject.GrpSizeX / 2 - AddDeltaX,
APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY,
APointObject.ActualPoints[1].x + APointObject.GrpSizeX / 2 - AddDeltax,
APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY);
CrossPoints[3] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y,
APointObject.ActualPoints[1].x + APointObject.GrpSizeX / 2 - AddDeltaX,
APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY,
APointObject.ActualPoints[1].x - APointObject.GrpSizeX / 2 + AddDeltaX,
APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY);
SetLength(Points, 4);
Points[0].x := (APointObject.ActualPoints[1].x - APointObject.GrpSizeX / 2 + AddDeltaX) - 0.1;
Points[0].y := (APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY) + 0.1;
Points[1].x := (APointObject.ActualPoints[1].x - APointObject.GrpSizeX / 2 + AddDeltaX) - 0.1;
Points[1].y := (APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY) - 0.1;
Points[2].x := (APointObject.ActualPoints[1].x + APointObject.GrpSizeX / 2 - AddDeltaX) + 0.1;
Points[2].y := (APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY) - 0.1;
Points[3].x := (APointObject.ActualPoints[1].x + APointObject.GrpSizeX / 2 - AddDeltaX) + 0.1;
Points[3].y := (APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY) + 0.1;
end
else
begin
CrossPoints[0] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y,
APointObject.ActualPoints[1].x,
APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY,
APointObject.ActualPoints[1].x,
APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY);
CrossPoints[1] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y,
APointObject.ActualPoints[1].x,
APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY,
APointObject.ActualPoints[1].x + APointObject.GrpSizeX - 2*AddDeltaX,
APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY);
CrossPoints[2] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y,
APointObject.ActualPoints[1].x + APointObject.GrpSizeX - 2*AddDeltaX,
APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY,
APointObject.ActualPoints[1].x + APointObject.GrpSizeX - 2*AddDeltaX,
APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY);
CrossPoints[3] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y,
APointObject.ActualPoints[1].x + APointObject.GrpSizeX - 2*AddDeltaX,
APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY,
APointObject.ActualPoints[1].x,
APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY);
SetLength(Points, 4);
Points[0].x := (APointObject.ActualPoints[1].x) - 0.1;
Points[0].y := (APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY) + 0.1;
Points[1].x := (APointObject.ActualPoints[1].x) - 0.1;
Points[1].y := (APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY) - 0.1;
Points[2].x := (APointObject.ActualPoints[1].x + APointObject.GrpSizeX - 2 * AddDeltaX) + 0.1;
Points[2].y := (APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY) - 0.1;
Points[3].x := (APointObject.ActualPoints[1].x + APointObject.GrpSizeX - 2 * AddDeltaX) + 0.1;
Points[3].y := (APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY) + 0.1;
end;
end;
// ÏÐÈÂßÇÊÀ ÏÓÑÒÎÃÎ ÊÎÍÅÊÒÎÐÀ Ê ÎÁÜÅÊÒÓ
procedure SnapConnectorToPointObject(AConnector, APointObject: TConnectorObject; AOnRaise: Boolean = false; ASnapObjectToLine: Boolean = false);
var
i, j: integer;
CurrLine: TOrthoLine;
isExistInList: Boolean;
isInRegion: Boolean;
CurrConnector: TConnectorObject;
SideConn: TConnectorObject;
ConnectedConn: TConnectorObject;
Points: TDoublePointArr;
CrossPoints: array [1..4] of TDoublePoint;
RegHandle: HRGN;
MinLength: Double;
CurrLength: Double;
ConnectToPoint: TDoublePoint;
SaveFigureSnap: TFigure;
SavePrevFigureSnap: TFigure;
LHandle: integer;
TempNewConnList: TList;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
OtherList: TF_CAD;
OtherRaise: TConnectorObject;
AddDeltaX, AddDeltaY: double;
ComponWidth: Double;
SnapGrids,SnapGuides: Boolean;
begin
try
ConnectedConn := nil; //#From Oleg#
if Not ASnapObjectToLine then
begin
APointObject.ActualZOrder[1] := AConnector.ActualZOrder[1];
//if (not (F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) then
// AConnector.ActualZOrder[1] := APointObject.ActualZOrder[1]
end
else
begin
// Tolik
if (TConnectorObject(APointObject).Radius > 10000000) then
begin
if {(not (F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) or}
(( (TConnectorObject(APointObject).Radius - 11000000) = 999 ) or ( (TConnectorObject(APointObject).Radius - 11000000) = 0 )) then
AConnector.ActualZOrder[1] := APointObject.ActualZOrder[1]
else
AConnector.ActualZOrder[1] := TConnectorObject(APointObject).Radius - 11000000;// APointObject.ActualZOrder[1];
end
else
AConnector.ActualZOrder[1] := APointObject.ActualZOrder[1]
end;
APointObject.FConnRaiseType := AConnector.FConnRaiseType;
APointObject.FObjectFromRaise := AConnector.FObjectFromRaise;
RaiseConn := GetRaiseConn(AConnector);
if RaiseConn <> nil then
begin
RaiseConn.FObjectFromRaise := APointObject;
RaiseLine := GetRaiseLine(RaiseConn);
if RaiseLine <> nil then
RaiseLine.FObjectFromRaisedLine := APointObject;
end;
if (AConnector.FConnRaiseType = crt_BetweenFloorUp) or (AConnector.FConnRaiseType = crt_BetweenFloorDown) or (AConnector.FConnRaiseType = crt_TrunkUp) or (AConnector.FConnRaiseType = crt_TrunkDown) then
begin
APointObject.FID_ConnToPassage := AConnector.FID_ConnToPassage;
APointObject.FID_ListToPassage := AConnector.FID_ListToPassage;
OtherList := GetListByID(AConnector.FID_ListToPassage);
if OtherList <> nil then
begin
OtherRaise := TConnectorObject(GetFigureByID(OtherList, AConnector.FID_ConnToPassage));
if OtherRaise <> nil then
OtherRaise.FID_ConnToPassage := APointObject.ID;
end;
end;
AConnector.FConnRaiseType := crt_None;
AConnector.FObjectFromRaise := nil;
AConnector.FID_ConnToPassage := -1;
AConnector.FID_ListToPassage := -1;
TempNewConnList := TList.Create;
LHandle := GCadForm.PCad.GetLayerHandle(2);
isExistInList := False;
for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do
begin
CurrConnector := TConnectorObject(APointObject.JoinedConnectorsList[i]);
if CurrConnector = AConnector then
isExistInList := True;
end;
if not isExistInList then
begin
APointObject.JoinedConnectorslist.Add(AConnector);
AConnector.JoinedConnectorslist.Add(APointObject);
end;
GTempJoinedLinesConnectors.Clear;
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
SideConn := TConnectorObject(TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector1);
if SideConn <> AConnector then
GTempJoinedLinesConnectors.Add(SideConn);
SideConn := TConnectorObject(TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector2);
if SideConn <> AConnector then
GTempJoinedLinesConnectors.Add(SideConn);
end;
// åñëè ðàçâåòâëåíèå !!!
if AConnector.JoinedOrtholinesList.Count > 1 then
begin
for i := 1 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
CurrLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]);
if TConnectorObject(TOrthoLine(CurrLine.JoinConnector1)) = AConnector then
begin
CurrLine.JoinConnector1 := nil;
ConnectedConn := TConnectorObject.Create(CurrLine.ActualPoints[1].x, CurrLine.ActualPoints[1].y, AConnector.ActualZOrder[1],
LHandle, mydsNormal, GCadForm.PCad);
ConnectedConn.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(LHandle), ConnectedConn, False);
CurrLine.SetJConnector1(ConnectedConn);
APointObject.JoinedConnectorsList.Add(ConnectedConn);
ConnectedConn.JoinedConnectorsList.Add(APointObject);
TempNewConnList.Add(ConnectedConn);
end;
if TConnectorObject(TOrthoLine(CurrLine.JoinConnector2)) = AConnector then
begin
CurrLine.JoinConnector2 := nil;
ConnectedConn := TConnectorObject.Create(CurrLine.ActualPoints[2].x, CurrLine.ActualPoints[2].y, AConnector.ActualZOrder[1],
LHandle, mydsNormal, GCadForm.PCad);
ConnectedConn.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(LHandle), ConnectedConn, False);
CurrLine.SetJConnector2(ConnectedConn);
APointObject.JoinedConnectorsList.Add(ConnectedConn);
ConnectedConn.JoinedConnectorsList.Add(APointObject);
TempNewConnList.Add(ConnectedConn);
end;
end;
j := 1;
while j < AConnector.JoinedOrtholinesList.Count do
begin
AConnector.JoinedOrtholinesList.Delete(j);
end;
end;
// ïîëó÷èòü òî÷êè ïåðåñå÷åíèÿ ëèíèè ñ îáüåêòîì
for i := 0 to GTempJoinedLinesConnectors.Count - 1 do
begin
if i = 0 then
ConnectedConn := AConnector
else
if i > 0 then
ConnectedConn := TConnectorObject(TempNewConnList[i - 1]);
SideConn := TConnectorObject(GTempJoinedLinesConnectors[i]);
if (APointObject.DrawFigure.InFigures.Count = 1) and
CheckFigureByClassName(TFigure(APointObject.DrawFigure.InFigures[0]), 'TWMFObject') then
begin
//FormatFloat(ffMask, AObject.FDrawFigureAngle / pi * 180);
ComponWidth := APointObject.DrawFigure.GetBoundRect.Right - APointObject.DrawFigure.GetBoundRect.Left;
AddDeltaX := 0.04 * ComponWidth;
AddDeltaY := APointObject.GrpSizeY * 0.04;
end
else
begin
AddDeltaX := 0;
AddDeltaY := 0;
end;
//Âíóòðè äåëàåò òî, ÷òî íèæå.Äëÿ ýêîíîìèè ìåñòà, òàê êàê êîä ïîâòîðÿåòñÿ íèæå ïî êîäó
FillPOintsForConnect(SideConn,APointObject,ConnectedConn,AddDeltaX, AddDeltaY,Points,CrossPoints);
// ñîçäàòü ðåãèîí òî÷åê òî÷å÷íîãî îáüåêòà
MinLength := 0;
CurrLength := 0;
ConnectToPoint.x := 0;
ConnectToPoint.y := 0;
isInRegion := PtInPolygon(Points, CrossPoints[1]);
if isInRegion then
begin
CurrLength := SQRT(SQR(CrossPoints[1].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[1].y - SideConn.ActualPoints[1].y));
MinLength := CurrLength;
ConnectToPoint := CrossPoints[1];
end;
isInRegion := PtInPolygon(Points, CrossPoints[2]);
if isInRegion then
begin
CurrLength := SQRT(SQR(CrossPoints[2].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[2].y - SideConn.ActualPoints[1].y));
if (CurrLength <= MinLength) or (MinLength = 0) then
begin
ConnectToPoint := CrossPoints[2];
MinLength := CurrLength;
end;
end;
isInRegion := PtInPolygon(Points, CrossPoints[3]);
if isInRegion then
begin
CurrLength := SQRT(SQR(CrossPoints[3].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[3].y - SideConn.ActualPoints[1].y));
if (CurrLength <= MinLength) or (MinLength = 0) then
begin
ConnectToPoint := CrossPoints[3];
MinLength := CurrLength;
end;
end;
isInRegion := PtInPolygon(Points, CrossPoints[4]);
if isInRegion then
begin
CurrLength := SQRT(SQR(CrossPoints[4].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[4].y - SideConn.ActualPoints[1].y));
if (CurrLength <= MinLength) or (MinLength = 0) then
begin
ConnectToPoint := CrossPoints[4];
MinLength := CurrLength;
end;
end;
// ïîäâèíóòü ê ìåñòó ñîåäèíåíèÿ
SaveFigureSnap := GFigureSnap;
SavePrevFigureSnap := GPrevFigureSnap;
GFigureSnap := nil;
GPrevFigureSnap := nil;
// !!! Ïîäðàâíÿòü ïî àëãîðèòìó åñëè åñòü òî÷êà ñîåäèíåíèÿ
if (ConnectToPoint.x <> 0) and (ConnectToPoint.y <> 0) then
begin
if GCadform.PCad.SnapToGrids then
SnapGrids := true;
if GCadform.PCad.SnapToGuides then
SnapGuides := true;
GCadform.PCad.SnapToGrids := false;
GCadform.PCad.SnapToGuides := false;
ConnectedConn.Move(ConnectToPoint.x - ConnectedConn.ActualPoints[1].x,
ConnectToPoint.y - ConnectedConn.ActualPoints[1].y);
if SnapGrids then
GCadform.PCad.SnapToGrids := True;
if SnapGuides then
GCadform.PCad.SnapToGuides := True;
end;
if ConnectedConn.Selected then
ConnectedConn.Deselect;
// DELETE FROM PM
DeleteObjectFromPM(ConnectedConn.ID, ConnectedConn.Name);
GFigureSnap := SaveFigureSnap;
GPrevFigureSnap := SavePrevFigureSnap;
end;
if Not AOnRaise then //#FROM Oleg#
AutoConnectObjectToConnectors(APointObject, AConnector, TempNewConnList);
if TempNewConnList <> nil then
FreeAndNil(TempNewConnList);
SetConnBringToFront(APointObject);
ReCalcZCoordSnapObjects(APointObject);
// Ïðîòîêîë
GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + AConnector.Name + cCommon_Mes1
+ APointObject.Name + '"');
RefreshCAD(GCadForm.PCad);
if GCadForm.PCad.SnapToGrids then
begin
for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
// JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[j]);
// ReAlignLine(JoinedLine);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SnapConnectorToPointObject', E.Message);
end;
end;
// îáùåìòî ñàìà ïðîâåðêà íà íàëè÷èå ñâîáîäíîãî ôóíêöèîíàëüíîãî èíòåðôåéñà
Function CheckCurrLine(CurrLineInterf: TSCSInterfaces; APointObject: TConnectorObject):Boolean;
var i,j,k: Integer;
Interfac,InterfPoint: TSCSInterface;
SCSComponPoint: TSCSComponent;
begin
Result := False;
for j := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(APointObject.ID).SCSComponents.Count - 1 do
begin
SCSComponPoint := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(APointObject.ID).SCSComponents[j];
for k := 0 to SCSComponPoint.Interfaces.Count - 1 do
begin
InterfPoint := SCSComponPoint.Interfaces[k];
if InterfPoint.TypeI = itFunctional then
for i := 0 to CurrLineInterf.Count - 1 do
begin
Interfac := CurrLineInterf[i];
if Interfac.TypeI = itFunctional then
if Interfac.IsBusy = Bifalse then
begin
if InterfPoint.SideSection = Interfac.SideSection then
Result := true;
break;
end;
end;
end;
if Result then
break;
end;
end;
//Ïðîâåðêà åñëè APointObject èìååò òàêèå æå ïàðàìåòðû, êàê è CurrLine
Function CheckInterfacesSideSection(APointObject, AConnector: TConnectorObject; CurrLine: TOrtholine): Boolean;
var
SCSComponLine, SCSComponPoint: TSCSComponent;
LineInterf,PointInterf: TSCSInterfaces;
i,j,k: integer;
InterfacL,InterfacP: TSCSInterface;
begin
result := false;
//TODO âîçìîæíî íóæíî áóäåò äîáàâèòü öèêë, òàê êàê â Êàòàëîãå ìîæåò áûòü >1 êàáåëåé è ñ APointObject ìîæåò ïîòðåáóåòñÿ òî æå ñàìîåíóæíî áóäåò ïðîâåðèòü
if (F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents.Count = 0)or
(F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(APointObject.ID).SCSComponents.Count = 0) then
exit;
SCSComponPoint := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(APointObject.ID).SCSComponents[0];
//Èíòåðôåéñû òî÷å÷íîãî îáúåêòà
PointInterf := SCSComponPoint.Interfaces;
for k := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents.Count - 1 do
begin
SCSComponLine := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents[k];
// Èíòåðôåéñû Ëèíèè
LineInterf := SCSComponLine.interfaces;
IF CurrLine.JoinConnector1 = AConnector then
begin
for i := 0 to LineInterf.Count - 1 do
begin
InterfacL := LineInterf[i]; //Åñëè íàøëè íóæíûé èíòåðôåéñ
if InterfacL.Side = 1 then
break; //áðåêàåì
end;
for j := 0 to PointInterf.Count - 1 do
begin
InterfacP := PointInterf[j];
if InterfacL.SideSection = InterfacP.SideSection then //Åñëè ïàðàìåòðû ëèíåéíîãî îáúåêòà = ïàðàìåòðàì òî÷å÷íîãî
begin
result := true;
break;
end;
end;
end
else
IF CurrLine.JoinConnector2 = AConnector then //Âñå òî æå ñàìîå, êàê è ñî ñòîðîíîé ¹ 1
begin
for i := 0 to LineInterf.Count - 1 do
begin
InterfacL := LineInterf[i];
if InterfacL.Side = 2 then
break;
end;
for j := 0 to PointInterf.Count - 1 do
begin
InterfacP := PointInterf[j];
if InterfacL.SideSection = InterfacP.SideSection then
begin
result := true;
break;
end;
end;
end;
end;
end;
Procedure ClearLineInterfaces(APointObject, AConnector: TConnectorObject; var CurrLine: TOrtholine; FindFreeInterfac: Boolean);
var
i,j,m,n: integer;
Interfac: TSCSInterface;
CurrLineInterf: TSCSInterfaces;
SCSComponLine,JoinCompon, SCSComponPoint: TSCSComponent;
vList: TF_CAD;
JoinFigure: TFigure;
JoinCatalog: TSCSCatalog;
Multip: Boolean;
//Tolik
CanClear: Boolean;
currCatalog: TSCSCatalog;
begin
try
Multip := false;
//Tolik
CanClear := true;
//Ïðîâåðÿåì íà ìíîãîêðàòîíîñòü APointObject...
SCSComponPoint := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(APointObject.ID).SCSComponents[0];
CurrLineInterf := SCSComponPoint.Interfaces;
for i := 0 to CurrLineInterf.Count - 1 do
begin
Interfac := CurrLineInterf[i];
if Interfac.TypeI = itFunctional then
if Interfac.Multiple = BiTrue then
begin
Multip := true;
break;
end;
end;
//Åñëè APointObject íå ìíîãîêðàòíà, è íàéäåíà òðàññà ñî ñâîáîäíûì èíòåðôåéñîì èëè ïàðàìåòðû íå ñîâïàäàþò - ÂÛÕÎÄ
if ((not Multip)and FindFreeInterfac)or (not CheckInterfacesSideSection(APointObject, AConnector, CurrLine))or
(not SCSComponPoint.IDNetType in [3,4,5,7])then
exit;
IF CurrLine.JoinConnector1 = AConnector then //åñëè ëèíèÿ ñîåäåíåíà ñòîðîíîé ¹1
begin
for m := 0 to APointObject.JoinedConnectorsList.Count - 1 do
if APointObject.JoinedConnectorsList[m] = AConnector then
begin
currCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID);
if currCatalog <> nil then
begin
//for n := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents.Count - 1 do
for n := 0 to currCatalog.SCSComponents.Count - 1 do
begin
//ÑÊÑ-êîìïîíåíò
SCSComponLine := currCatalog.SCSComponents[n];//F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents[n];
// Tolik
// Ïðè àâòîòðàññèðîâêå ýëåêòðèêè íå âñå ñîåäèíåíèÿ â äàííîé òî÷êå íóæíî ðàçðûâàòü, à òîëüêî êàáåëè òîãî òèïà,
// êîòîðûé ïðîêëàäûâàåì â äàííûé ìîìåíò (åñëè èãíîðèòü ïðîëîæåííûé êàáåëü, òî òîëüêî â òîì ñëó÷àå, åñëè êàáåëü - ïîñëåäíèé èç ïðîëîæåííûõ â òðàññå)
if (F_PEAutoTraceDialog.FromAutoTraceDialog and (F_PEAutoTraceDialog.Cypher <> '')) then
begin
if ((SCSComponLine.Cypher <> F_PEAutoTraceDialog.Cypher) or ((SCSComponLine.Cypher = F_PEAutoTraceDialog.Cypher) and
(F_PEAutoTraceDialog.IgnoreExistingCable.Visible) and (F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and
(SCSComponLine <> currCatalog.LastAddedComponent))) then
CanClear := False;
end;
if CanClear then
begin
//Åãî èíòåðôåéñû
CurrLineInterf := SCSComponLine.Interfaces;
for i := 0 to CurrLineInterf.Count - 1 do
begin
//Òåêóùèé èíòåðôåéñ
Interfac := CurrLineInterf[i];
//Åñëè îí ôóíêöèîíàëüíûé
if Interfac.TypeI = itFunctional then
//È åñëè îíà çàíÿò
if Interfac.IsBusy = BiTrue then
//È åãî ñòîðîíà = ñòîðîíå ïîäêëþ÷åíèÿ ñ AConnector
if Interfac.Side = 1 then
begin
//Ïîëó÷àåì Ôîðìó ÊÀÄÀ
vList := GetListByID(SCSCOmponLine.ListID);
j := 0;
While j < SCSComponLine.JoinedComponents.Count do
begin
//Óæå ïîäêëþ÷åííûé êîìïîíåíòû
JoinCompon := SCSComponLine.JoinedComponents[j];
//Îïðåäåëÿåì ÔÈÃÓÐÓ
JoinFigure := GetFigureByID(vList,JoinCompon.GetFirstParentCatalog.SCSID);
if JoinFigure <> nil then
begin
if ((SCSComponLine.IDNetType in [3,4,5,7])and
(JoinCompon.IDNetType in [3,4,5,7])) then
begin
//Åñëè ïîäêëþ÷åíà îðòîëèíèÿ
if JoinFigure.ClassName = 'TOrthoLine' then
//TODO ïðîâåðèòü åñòü ëè ó APointObject ñõîæèå ñ SCSComponLine èíòåðôåéñû
//åñëè ïîñîåäåíåííàÿ ëèíèÿ ëåæèò îäíîé èç ñòîðîí íà íóæíîì ñîåäåíèòåëå - Îòñîåäåíÿåì
if (TOrthoLine(JoinFigure).JoinConnector1 = AConnector)or(TOrthoLine(JoinFigure).JoinConnector2 = AConnector) then
begin
SCSComponLine.DisJoinFrom(JoinCompon);
end;
{else
Inc(j);}
if JoinFigure.ClassName = 'TConnectorObject' then
if TConnectorObject(JoinFigure).JoinedConnectorsList.IndexOf(AConnector) <> -1 then
begin
SCSComponLine.DisJoinFrom(JoinCompon);
end;
{else
Inc(j);}
end;
end;
inc(j);
end;
end;
end;
end;
end;
end;
end;
end
else
//Òóòà òàêàÿ æå ñõåìà, òîëüêî ñî âòîðîé ñòîðîíîé ëèíèè
IF CurrLine.JoinConnector2 = AConnector then //Ñòîðîíîé ¹2
begin
for m := 0 to APointObject.JoinedConnectorsList.Count - 1 do
if APointObject.JoinedConnectorsList[m] = AConnector then
begin
currCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID);
if currCatalog <> nil then
begin
// for n := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents.Count - 1 do
for n := 0 to currCatalog.SCSComponents.Count - 1 do
begin
SCSComponLine := currCatalog.SCSComponents[n];//F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents[n];
// Tolik
// Ïðè àâòîòðàññèðîâêå ýëåêòðèêè íå âñå ñîåäèíåíèÿ â äàííîé òî÷êå íóæíî ðàçðûâàòü, à òîëüêî êàáåëè òîãî òèïà,
// êîòîðûé ïðîêëàäûâàåì â äàííûé ìîìåíò
if (F_PEAutoTraceDialog.FromAutoTraceDialog and (F_PEAutoTraceDialog.Cypher <> '')) then
begin
// if SCSComponLine.Cypher <> F_PEAutoTraceDialog.Cypher then
if ((SCSComponLine.Cypher <> F_PEAutoTraceDialog.Cypher) or ((SCSComponLine.Cypher = F_PEAutoTraceDialog.Cypher) and
(F_PEAutoTraceDialog.IgnoreExistingCable.Visible) and (F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and
(SCSComponLine <> currCatalog.LastAddedComponent))) then
CanClear := False;
end;
if CanClear then
begin
CurrLineInterf := SCSComponLine.Interfaces;
for i := 0 to CurrLineInterf.Count - 1 do
begin
Interfac := CurrLineInterf[i];
if Interfac.TypeI = itFunctional then
if Interfac.IsBusy = BiTrue then
if Interfac.Side = 2 then
begin
vList := GetListByID(SCSCOmponLine.ListID);
j := 0;
While j < SCSComponLine.JoinedComponents.Count do
begin
JoinCompon := SCSComponLine.JoinedComponents[j];
JoinFigure := GetFigureByID(vList,JoinCompon.GetFirstParentCatalog.SCSID);
if JoinFigure <> nil then
begin
if ((SCSComponLine.IDNetType in [3,4,5,7])and
(JoinCompon.IDNetType in [3,4,5,7])) then
begin
if JoinFigure.ClassName = 'TOrthoLine' then
//TODO ïðîâåðèòü åñòü ëè ó APointObject ñõîæèå ñ SCSComponLine èíòåðôåéñû
if (TOrthoLine(JoinFigure).JoinConnector1 = AConnector)or(TOrthoLine(JoinFigure).JoinConnector2 = AConnector) then
begin
SCSComponLine.DisJoinFrom(JoinCompon);
end;
if JoinFigure.ClassName = 'TConnectorObject' then
if TConnectorObject(JoinFigure).JoinedConnectorsList.IndexOf(AConnector) <> -1 then
begin
SCSComponLine.DisJoinFrom(JoinCompon);
end;
end;
end;
Inc(j);
end;
end;
end;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ClearLineInterfaces', E.Message);
end;
end;
// ÏÐÈÂßÇÊÀ ÏÓÑÒÎÃÎ ÊÎÍÅÊÒÎÐÀ Ê ÎÁÜÅÊÒÓ
procedure SnapPointObjectToConnector(APointObject, AConnector: TConnectorObject; AOnRaise: Boolean = false);
var
i, j: integer;
CurrLine: TOrthoLine;
isExistInList: Boolean;
isInRegion: Boolean;
CurrConnector: TConnectorObject;
SideConn: TConnectorObject;
ConnectedConn: TConnectorObject;
Points: TDoublePointArr;
CrossPoints: array [1..4] of TDoublePoint;
RegHandle: HRGN;
MinLength: Double;
CurrLength: Double;
ConnectToPoint: TDoublePoint;
SaveFigureSnap: TFigure;
SavePrevFigureSnap: TFigure;
LHandle: integer;
FindRaise: TConnectorObject;
TempNewConnList: TList;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
OtherList: TF_CAD;
OtherRaise: TConnectorObject;
AddDeltaX, AddDeltaY: Double;
ComponWidth: Double;
SnapGrids,SnapGuides: Boolean;
FindFreeLine: Boolean;
RememberI, StartCicle: Integer;
begin
try
FindFreeLine := false; //From Dimon ;)
RememberI := -1;
ConnectedConn := nil; //#From Oleg#
APointObject.ActualZOrder[1] := AConnector.ActualZOrder[1];
APointObject.FConnRaiseType := AConnector.FConnRaiseType;
APointObject.FObjectFromRaise := AConnector.FObjectFromRaise;
RaiseConn := GetRaiseConn(AConnector);
if RaiseConn <> nil then
begin
RaiseConn.FObjectFromRaise := APointObject;
RaiseLine := GetRaiseLine(RaiseConn);
if RaiseLine <> nil then
RaiseLine.FObjectFromRaisedLine := APointObject;
end;
if (AConnector.FConnRaiseType = crt_BetweenFloorUp) or (AConnector.FConnRaiseType = crt_BetweenFloorDown) or (AConnector.FConnRaiseType = crt_TrunkUp) or (AConnector.FConnRaiseType = crt_TrunkDown) then
begin
APointObject.FID_ConnToPassage := AConnector.FID_ConnToPassage;
APointObject.FID_ListToPassage := AConnector.FID_ListToPassage;
OtherList := GetListByID(AConnector.FID_ListToPassage);
if OtherList <> nil then
begin
OtherRaise := TConnectorObject(GetFigureByID(OtherList, AConnector.FID_ConnToPassage));
if OtherRaise <> nil then
OtherRaise.FID_ConnToPassage := APointObject.ID;
end;
end;
AConnector.FConnRaiseType := crt_None;
AConnector.FObjectFromRaise := nil;
AConnector.FID_ConnToPassage := -1;
AConnector.FID_ListToPassage := -1;
FindRaise := GetRaiseConn(APointObject);
if FindRaise <> nil then
begin
SnapConnectorToConnector(AConnector, FindRaise);
Exit;
end;
SaveFigureSnap := GFigureSnap;
SavePrevFigureSnap := GPrevFigureSnap;
GFigureSnap := nil;
GPrevFigureSnap := nil;
APointObject.Move(AConnector.ActualPoints[1].x - APointObject.ActualPoints[1].x,
AConnector.ActualPoints[1].y - APointObject.ActualPoints[1].y);
GFigureSnap := SaveFigureSnap;
GPrevFigureSnap := SavePrevFigureSnap;
TempNewConnList := TList.Create;
LHandle := GCadForm.PCad.GetLayerHandle(2);
isExistInList := False;
for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do
begin
CurrConnector := TConnectorObject(APointObject.JoinedConnectorsList[i]);
if CurrConnector = AConnector then
isExistInList := True;
end;
if not isExistInList then
begin
APointObject.JoinedConnectorslist.Add(AConnector);
AConnector.JoinedConnectorslist.Add(APointObject);
end;
// ñîõðàíèòü êîíåêòîðû - íà÷àëüíûå òî÷êè ïðèñîåäèíåííûõ ëèíèé
GTempJoinedLinesConnectors.Clear;
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
SideConn := TConnectorObject(TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector1);
if SideConn <> AConnector then
GTempJoinedLinesConnectors.Add(SideConn);
SideConn := TConnectorObject(TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector2);
if SideConn <> AConnector then
GTempJoinedLinesConnectors.Add(SideConn);
end;
// åñëè ðàçâåòâëåíèå !!!
if AConnector.JoinedOrtholinesList.Count > 1 then
begin
//Ïðåäâàðèòåëüíûé ïîèñêà òðàññû ñî ñâîáîäíûì èíòåðôåéñîì
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
CurrLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]);
if not FindFreeLine then //From Dimon ;)
begin
//TODO: Òóò òîæå, ñêîðåé âñåãî, íóæíî ïðîéòèñü ïî âñåì ñêñ-êîìïîíåíòàì...
for j := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents.Count - 1 do
if CheckCurrLine(F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents[j].Interfaces, APointObject)then
begin
RememberI := i;
FindFreeLine := true;
Break;
end;
end;
if FindFreeLine then
Break;
end;
if FindFreeLine then
StartCicle := 0
else
StartCicle := 1;
for i := StartCicle to AConnector.JoinedOrtholinesList.Count - 1 do
begin
CurrLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]);
if i = RememberI then
continue;
ClearLineInterfaces(APointObject, AConnector,CurrLine, FindFreeLine);
if TConnectorObject(TOrthoLine(CurrLine.JoinConnector1)) = AConnector then
begin
CurrLine.JoinConnector1 := nil;
ConnectedConn := TConnectorObject.Create(CurrLine.ActualPoints[1].x, CurrLine.ActualPoints[1].y, AConnector.ActualZOrder[1],
LHandle, mydsNormal, GCadForm.PCad);
ConnectedConn.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(LHandle), ConnectedConn, False);
CurrLine.SetJConnector1(ConnectedConn);
APointObject.JoinedConnectorsList.Add(ConnectedConn);
ConnectedConn.JoinedConnectorsList.Add(APointObject);
TempNewConnList.Add(ConnectedConn);
if CurrLine.FIsRaiseUpDown then
begin
ConnectedConn.LockMove := True;
ConnectedConn.LockModify := True;
end;
end;
if TConnectorObject(TOrthoLine(CurrLine.JoinConnector2)) = AConnector then
begin
CurrLine.JoinConnector2 := nil;
ConnectedConn := TConnectorObject.Create(CurrLine.ActualPoints[2].x, CurrLine.ActualPoints[2].y, AConnector.ActualZOrder[1],
LHandle, mydsNormal, GCadForm.PCad);
ConnectedConn.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(LHandle), ConnectedConn, False);
CurrLine.SetJConnector2(ConnectedConn);
APointObject.JoinedConnectorsList.Add(ConnectedConn);
ConnectedConn.JoinedConnectorsList.Add(APointObject);
TempNewConnList.Add(ConnectedConn);
if CurrLine.FIsRaiseUpDown then
begin
ConnectedConn.LockMove := True;
ConnectedConn.LockModify := True;
end;
end;
end;
if Assigned(CurrLine) then
CurrLine := nil;
if RememberI <> -1 then
begin
CurrLine := TOrthoLine(AConnector.JoinedOrtholinesList[RememberI]);
j := 0;
end
else
j := 1;
while j < AConnector.JoinedOrtholinesList.Count do
begin
if TOrthoLine(AConnector.JoinedOrtholinesList[j]) <> CurrLine then
AConnector.JoinedOrtholinesList.Delete(j)
else
inc(j);
end;
end;
// ïîëó÷èòü òî÷êè ïåðåñå÷åíèÿ ëèíèè ñ îáüåêòîì
for i := 0 to GTempJoinedLinesConnectors.Count - 1 do
begin
if i = 0 then
ConnectedConn := AConnector
else
if i > 0 then
ConnectedConn := TConnectorObject(TempNewConnList[i - 1]);
SideConn := TConnectorObject(GTempJoinedLinesConnectors[i]);
if (APointObject.DrawFigure.InFigures.Count = 1) and
CheckFigureByClassName(TFigure(APointObject.DrawFigure.InFigures[0]), 'TWMFObject') then
begin
ComponWidth := APointObject.DrawFigure.GetBoundRect.Right - APointObject.DrawFigure.GetBoundRect.Left;
AddDeltaX := 0.04 * ComponWidth;
AddDeltaY := APointObject.GrpSizeY * 0.04;
end
else
begin
AddDeltaX := 0;
AddDeltaY := 0;
end;
//Âíóòðè äåëàåò òî, ÷òî íèæå
FillPOintsForConnect(SideConn,APointObject,ConnectedConn,AddDeltaX, AddDeltaY,Points,CrossPoints);
// ñîçäàòü ðåãèîí òî÷åê òî÷å÷íîãî îáüåêòà
MinLength := 0;
CurrLength := 0;
ConnectToPoint.x := 0;
ConnectToPoint.y := 0;
isInRegion := PtInPolygon(Points, CrossPoints[1]);
if isInRegion then
begin
CurrLength := SQRT(SQR(CrossPoints[1].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[1].y - SideConn.ActualPoints[1].y));
MinLength := CurrLength;
ConnectToPoint := CrossPoints[1];
end;
isInRegion := PtInPolygon(Points, CrossPoints[2]);
if isInRegion then
begin
CurrLength := SQRT(SQR(CrossPoints[2].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[2].y - SideConn.ActualPoints[1].y));
if (CurrLength <= MinLength) or (MinLength = 0) then
begin
ConnectToPoint := CrossPoints[2];
MinLength := CurrLength;
end;
end;
isInRegion := PtInPolygon(Points, CrossPoints[3]);
if isInRegion then
begin
CurrLength := SQRT(SQR(CrossPoints[3].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[3].y - SideConn.ActualPoints[1].y));
if (CurrLength <= MinLength) or (MinLength = 0) then
begin
ConnectToPoint := CrossPoints[3];
MinLength := CurrLength;
end;
end;
isInRegion := PtInPolygon(Points, CrossPoints[4]);
if isInRegion then
begin
CurrLength := SQRT(SQR(CrossPoints[4].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[4].y - SideConn.ActualPoints[1].y));
if (CurrLength <= MinLength) or (MinLength = 0) then
begin
ConnectToPoint := CrossPoints[4];
MinLength := CurrLength;
end;
end;
// ïîäâèíóòü ê ìåñòó ñîåäèíåíèÿ
SaveFigureSnap := GFigureSnap;
SavePrevFigureSnap := GPrevFigureSnap;
GFigureSnap := nil;
GPrevFigureSnap := nil;
// !!! Ïîäðàâíÿòü ïî àëãîðèòìó åñëè åñòü òî÷êà ñîåäèíåíèÿ
if (ConnectToPoint.x <> 0) and (ConnectToPoint.y <> 0) then
begin
if GCadform.PCad.SnapToGrids then
SnapGrids := true;
if GCadform.PCad.SnapToGuides then
SnapGuides := true;
GCadform.PCad.SnapToGrids := false;
GCadform.PCad.SnapToGuides := false;
if not CheckJoinVertical(ConnectedConn) then
ConnectedConn.Move(ConnectToPoint.x - ConnectedConn.ActualPoints[1].x, ConnectToPoint.y - ConnectedConn.ActualPoints[1].y);
if SnapGrids then
GCadform.PCad.SnapToGrids := True;
if SnapGuides then
GCadform.PCad.SnapToGuides := True;
end;
if ConnectedConn.Selected then
ConnectedConn.Deselect;
// DELETE FROM PM
DeleteObjectFromPM(ConnectedConn.ID, ConnectedConn.Name);
GFigureSnap := SaveFigureSnap;
GPrevFigureSnap := SavePrevFigureSnap;
end;
AutoConnectObjectToConnectors(APointObject, AConnector, TempNewConnList);
if TempNewConnList <> nil then
FreeAndNil(TempNewConnList);
ReCalcZCoordSnapObjects(APointObject);
// Ïðîòîêîë
GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + APointObject.Name + cCommon_Mes1
+ AConnector.Name + '"');
RefreshCAD(GCadForm.PCad);
if GCadForm.PCad.SnapToGrids then
begin
for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[j]);
ReAlignLine(JoinedLine);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SnapPointObjectToConnector', E.Message);
end;
end;
// ÎÒÂßÇÊÀ ÏÓÑÒÎÃÎ ÊÎÍÅÊÒÎÐÀ ÎÒ ÎÁÜÅÊÒÓ
procedure UnsnapConnectorFromPointObject(AConnector, APointObject: TConnectorObject; AOnRaise: Boolean = false);
var
i, j: integer;
SaveFigureSnap: TFigure;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
isDisconnected: Boolean;
ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam;
ParamsList1, ParamsList2: TList;
begin
BaseBeginUpdate;
try
AConnector.JoinedConnectorsList.Remove(APointObject);
APointObject.JoinedConnectorsList.Remove(AConnector);
if Not AOnRaise then
begin
ParamsList1 := TList.create;
ParamsList2 := TList.create;
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]);
JoinedLine.UpdateLengthTextBox(false, true);
New(ptrInterfRecord1);
ptrInterfRecord1.IDObject := JoinedLine.ID;
if AConnector = JoinedLine.JoinConnector1 then
ptrInterfRecord1.Side := 1;
if AConnector = JoinedLine.JoinConnector2 then
ptrInterfRecord1.Side := 2;
ParamsList1.Add(ptrInterfRecord1);
end;
// çàíåñòè äàííûå ñ ÒÎ
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := APointObject.ID;
ptrInterfRecord2.Side := -1;
ParamsList2.Add(ptrInterfRecord2);
// çàíåñòè äàííûå ñ ïðèñîåäèíåííûõ ëèíèé
for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]);
if JoinedConn <> AConnector then
begin
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := JoinedLine.ID;
if JoinedConn = JoinedLine.JoinConnector1 then
ptrInterfRecord2.Side := 1;
if JoinedConn = JoinedLine.JoinConnector2 then
ptrInterfRecord2.Side := 2;
ParamsList2.Add(ptrInterfRecord2);
end;
end;
end;
isDisconnected := DisconnectObjectsInPM(ParamsList1, ParamsList2);
end;
AConnector.Name := cCadClasses_Mes12;
AddConnObjectInPM(AConnector.ID, AConnector.FCabinetID, AConnector.Name);
//Åñëè ê ñîåäåíèòåëþ ïîäêëþ÷åíà òðàññà, ñòàâèì åìó âûñîòó òðàññû
if AConnector.JoinedOrtholinesList.Count > 0 then
begin
if (APointObject.ActualZOrder[1] >= TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1])
and(APointObject.ActualZOrder[1] >= TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2])then
begin
if TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1] < TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2] then
AConnector.ActualZOrder[1] := TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1]
else
AConnector.ActualZOrder[1] := TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2];
end
else
begin
if TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1] < TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2] then
AConnector.ActualZOrder[1] := TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2]
else
AConnector.ActualZOrder[1] := TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1];
end;
end
else //èíà÷å îñòàâëÿåì íà òàêîé æå âûñîòå
AConnector.ActualZOrder[1] := APointObject.ActualZOrder[1];
SetConFigureCoordZInPM(AConnector.ID, AConnector.ActualZOrder[1]);
// óäàëèòü ñ-ï
if APointObject.FObjectFromRaise <> nil then
begin
// DestroyRaiseOnPointObject(APointObject.FObjectFromRaise);
// APointObject.Delete;
// RefreshCAD(GCadForm.PCad);
end;
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]);
JoinedLine.CalculLength := JoinedLine.LengthCalc;
JoinedLine.LineLength := JoinedLine.CalculLength;
JoinedLine.UpdateLengthTextBox(false, true);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.UnsnapConnectorFromPointObject', E.Message);
end;
BaseEndUpdate;
end;
function GetCrossPoint(X1_Line, Y1_Line, X2_Line, Y2_Line, X1_Object, Y1_Object, X2_Object, Y2_Object: Double): TDoublePoint;
var
A1, B1, C1: Double;
A2, B2, C2: Double;
x, y: Double;
F1, F2: Double;
begin
try
Result := DoublePoint(0, 0);
x := 0; //#From Oleg#
y := 0; //#From Oleg#
A1 := Y2_Line - Y1_Line;
if A1 = 0 then
A1 := 0.001;
B1 := - (X2_Line - X1_Line);
if B1 = 0 then
B1 := 0.001;
C1 := - A1 * X1_Line - B1 * Y1_Line;
A2 := Y2_Object - Y1_Object;
B2 := - (X2_Object - X1_Object);
C2 := - A2 * X1_Object - B2 * Y1_Object;
//14.09.2010 F1 := A1 * x + B1 * y + C1;
//14.09.2010 F2 := A2 * x + B2 * y + C2;
try
x := (B2 * C1 - B1 * C2) / (A2 * B1 - A1 * B2);
except
x := (B2 * C1 - B1 * C2);
end;
try
y := (A1 * x + C1) / (- B1);
except
y := (A1 * x + C1);
end;
Result.x := x;
Result.y := y;
except
on E: Exception do addExceptionToLogEx('U_Common.GetCrossPoint', E.Message);
end;
end;
procedure CheckingSnapConnectorToOrtholine(AConnector: TConnectorObject; ASnapLine: TOrtholine);
var
i: integer;
LastObjectHeight: double;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
JoinedLine: TOrthoLine;
ObjFromRaise: TConnectorObject;
begin
BaseBeginUpdate;
try
if AConnector.JoinedConnectorsList.Count = 0 then
begin
// ïóñòîé êîíåêòîð ê ëèíèè
LastObjectHeight := AConnector.ActualZOrder[1];
// âûñîòû íå ñîâïàäàþò
if LastObjectHeight <> ASnapLine.ActualZOrder[1] then
begin
CreateRaiseOnConnector(AConnector, ASnapLine.ActualZOrder[1]);
RaiseConn := GetRaiseConn(AConnector);
SnapConnectorToOrtholine(RaiseConn, ASnapLine);
end
else
SnapConnectorToOrtholine(AConnector, ASnapLine);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckingSnapConnectorToOrtholine', E.Message);
end;
BaseEndUpdate;
end;
procedure CheckingSnapPointObjectToOrthoLine(APointObject: TConnectorObject; ASnapLine: TOrthoLine);
var
i: integer;
LastObjectHeight: double;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
JoinedLine: TOrthoLine;
ObjFromRaise: TConnectorObject;
SnapConn: TConnectorObject;
TracesList: TList;
begin
if (IsSpecialTraceFigure(ASnapLine)) or (ASnapLine.FIsVertical) then
exit;
BaseBeginUpdate;
BeginDevideLine;
try
if HaveObjectCorkComponent(APointObject.ID) then
APointObject.ActualZOrder[1] := ASnapLine.ActualZOrder[1];
LastObjectHeight := APointObject.ActualZOrder[1];
// îáüåêò ê ëèíèè
TracesList := GetAllConnectedTraces(APointObject);
SnapPointObjectToOrthoLine(APointObject, ASnapLine);
// âûñîòû íå ñîâïàäàþò
//Tolik
// if LastObjectHeight <> APointObject.ActualZOrder[1] then
if (TConnectorObject(APointObject).Radius > 10000000) then
begin
if ( (LastObjectHeight <> APointObject.ActualZOrder[1]) or (((TConnectorObject(APointObject).Radius - 11000000) <> 999) and
((TConnectorObject(APointObject).Radius - 11000000) <> APointObject.ActualZOrder[1])) ) then
begin
//Tolik
{if ( (not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) and
((TConnectorObject(APointObject).Radius - 11000000) <> 999 )
) then
begin}
// ñîçäàòü ñïóñê/ïîäúåì
// Tolik
// CreateRaiseOnPointObject(APointObject, LastObjectHeight);
// CreateRaiseOnPointObject(APointObject, TConnectorObject(APointObject).Radius - 11000000);
CreateRaiseOnPointObject(APointObject, TConnectorObject(APointObject).ActualZOrder[1]);
// âåðíóòü ðàíåå ïîäêëþ÷åííûå òðàññû íà èõ âûñîòó
for i := 0 to TracesList.Count - 1 do
begin
JoinedLine := TOrthoLine(TracesList[i]);
RaiseLineOnHeight(JoinedLine, TConnectorObject(APointObject).Radius - 11000000{LastObjectHeight}, TracesList);
end;
{ end;}
end;
end
else
begin
if LastObjectHeight <> APointObject.ActualZOrder[1] then
begin
CreateRaiseOnPointObject(APointObject, LastObjectHeight);
// âåðíóòü ðàíåå ïîäêëþ÷åííûå òðàññû íà èõ âûñîòó
for i := 0 to TracesList.Count - 1 do
begin
JoinedLine := TOrthoLine(TracesList[i]);
RaiseLineOnHeight(JoinedLine, LastObjectHeight, TracesList);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckingSnapPointObjectToOrthoLine', E.Message);
end;
EndDevideLine;
BaseEndUpdate;
end;
procedure CheckingSnapConnectorToConnector(AConnector, ASnapConnector: TConnectorObject);
var
i: integer;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
JoinedLine: TOrthoLine;
ObjFromRaise: TConnectorObject;
begin
BaseBeginUpdate;
try
RaiseLine := nil; //#From Oleg#
RaiseConn := GetRaiseConn(ASnapConnector);
if RaiseConn <> nil then
RaiseLine := GetRaiseLine(RaiseConn);
// ÍÅÒ Ñ-Ï
if (ASnapConnector.FConnRaiseType = crt_None) and (RaiseConn = nil) then
begin
if AConnector.ActualZOrder[1] <> ASnapConnector.ActualZOrder[1] then
begin
//15.09.2010 CreateRaiseOnConnector(ASnapConnector, AConnector.ActualZOrder[1]);
//15.09.2010 ASnapConnector := GetRaiseConn(ASnapConnector);
//15.09.//#From Oleg#
if Not CheckJoinVertical(ASnapConnector) then
begin
// Åñëè íåòó ïîäêëþ÷åííûõ âåðòèêàëüíûõ òðàññ, ñîçäàåì Ñ-Ï
CreateRaiseOnConnector(ASnapConnector, AConnector.ActualZOrder[1]);
ASnapConnector := GetRaiseConn(ASnapConnector);
end
else
begin
// Èùåì ñîåäèíèòåëü ìåæäó Â-Ò (âåðòèêàëüí. òðàññàìè) ïîäõîäÿùèé ïî âûñîòå
ASnapConnector := GetJoinedVerticalConnectorByCoordZ(ASnapConnector, AConnector.ActualZOrder[1]);
// Åñëè íå ñîåäèíèòåëü, òî íå ïîäêëþ÷àåì
if (ASnapConnector <> nil) and (TConnectorObject(ASnapConnector).ConnectorType <> ct_Clear) then
ASnapConnector := nil;
end;
end;
//14.09.2010 SnapConnectorToConnector(AConnector, ASnapConnector);
if ASnapConnector <> nil then
SnapConnectorToConnector(AConnector, ASnapConnector);
end
else
// ÝÒÎ ÂÅÐØÈÍÀ Ñ-Ï
if ASnapConnector.FConnRaiseType <> crt_None then
begin
SnapConnectorToConnector(AConnector, ASnapConnector);
end
else
// ÝÒÎ ÎÁÚÅÊÒ ÍÀ ÊÎÒOÐÎÌ Ñ-Ï
if RaiseConn <> nil then
begin
if (AConnector.ActualZOrder[1] = RaiseConn.ActualZOrder[1]) then
begin
if RaiseConn.ConnectorType = ct_Clear then
SnapConnectorToConnector(AConnector, RaiseConn)
else
SnapConnectorToPointObject(AConnector, RaiseConn);
end
else
begin
SnapConnectorToConnector(AConnector, ASnapConnector);
if RaiseConn <> nil then
RaiseConn.FObjectFromRaise := AConnector;
if RaiseLine <> nil then
RaiseLine.FObjectFromRaisedLine := AConnector;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckingSnapConnectorToConnector', E.Message);
end;
BaseEndUpdate;
end;
procedure CheckingSnapConnectorToPointObject(AConnector, APointObject: TConnectorObject; aUseBaseConnector: Boolean);
var
LastObjectHeight: double;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
i, j: integer;
JoinedLine: TOrthoLine;
SnapObject: TConnectorObject;
begin
BaseBeginUpdate;
try
RaiseLine := nil; //#From Oleg#
RaiseConn := GetRaiseConn(APointObject);
if RaiseConn <> nil then
RaiseLine := GetRaiseLine(RaiseConn);
// ÍÅÒ Ñ-Ï
if (APointObject.FConnRaiseType = crt_None) and (RaiseConn = nil) then
begin
LastObjectHeight := APointObject.ActualZOrder[1];
//#From Oleg# 15.09.2010
//SnapConnectorToPointObject(AConnector, APointObject);
// âûñîòû íå ñîâïàäàþò
//if LastObjectHeight <> APointObject.ActualZOrder[1] then
//begin
// if aUseBaseConnector then
// CreateRaiseOnPointObject(APointObject, LastObjectHeight, AConnector)
// else
// CreateRaiseOnPointObject(APointObject, LastObjectHeight, nil);
//end;
//#From Oleg# //15.09.2010
SnapObject := nil;
// Åñëè íå ñîâïàäàþò âûñîòû è APointObject ïîäêëþ÷åí ê âåðòèêàëüíîé òðàññå, èùåì ñîåäèíèòåëü ïî âûñîòå AConnector
if (AConnector.ActualZOrder[1] <> APointObject.ActualZOrder[1]) then
if CheckJoinVertical(APointObject) then
SnapObject := GetJoinedVerticalConnectorByCoordZ(APointObject, AConnector.ActualZOrder[1]);
if SnapObject = nil then
begin
SnapConnectorToPointObject(AConnector, APointObject);
// âûñîòû íå ñîâïàäàþò
if LastObjectHeight <> APointObject.ActualZOrder[1] then
begin
if aUseBaseConnector then
CreateRaiseOnPointObject(APointObject, LastObjectHeight, AConnector)
else
CreateRaiseOnPointObject(APointObject, LastObjectHeight, nil);
end;
end
else
begin
if SnapObject.ConnectorType = ct_Clear then
SnapConnectorToConnector(AConnector, SnapObject)
else
SnapConnectorToPointObject(AConnector, SnapObject);
end;
end
else
// ÝÒÎ ÂÅÐØÈÍÀ Ñ-Ï
if APointObject.FConnRaiseType <> crt_None then
begin
SnapConnectorToPointObject(AConnector, APointObject);
end
else
// ÝÒÎ ÎÁÚÅÊÒ ÍÀ ÊÎÒÎÐÎÌ Ñ-Ï
if RaiseConn <> nil then
begin
if (AConnector.ActualZOrder[1] = RaiseConn.ActualZOrder[1]) then
begin
if RaiseConn.ConnectorType = ct_Clear then
SnapConnectorToConnector(AConnector, RaiseConn)
else
SnapConnectorToPointObject(AConnector, RaiseConn);
end
else
begin
AConnector.ActualZOrder[1] := APointObject.ActualZOrder[1];
SnapConnectorToPointObject(AConnector, APointObject);
if RaiseConn <> nil then
RaiseConn.FObjectFromRaise := APointObject;
if RaiseLine <> nil then
RaiseLine.FObjectFromRaisedLine := APointObject;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckingSnapConnectorToPointObject', E.Message);
end;
BaseEndUpdate;
end;
procedure CheckingSnapPointObjectToConnector(APointObject, AConnector: TConnectorObject);
var
LastObjectHeight: double;
RaiseConn: TConnectorObject;
ObjFromRaise: TConnectorObject;
RaiseLine: TOrthoLine;
i, j: integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
RaiseType: TConnRaiseType;
TracesList: TList;
begin
BaseBeginUpdate;
try
RaiseLine := nil; //#From Oleg#
RaiseConn := GetRaiseConn(AConnector);
ObjFromRaise := AConnector.FObjectFromRaise;
if RaiseConn <> nil then
RaiseLine := GetRaiseLine(RaiseConn);
// Çàãëóøêà
if HaveObjectCorkComponent(APointObject.ID) then
APointObject.ActualZOrder[1] := AConnector.ActualZOrder[1];
// ÍÅÒ Ñ-Ï
if (AConnector.FConnRaiseType = crt_None) and (RaiseConn = nil) then
begin
LastObjectHeight := APointObject.ActualZOrder[1];
TracesList := getAllConnectedTraces(APointObject);
SnapPointObjectToConnector(APointObject, AConnector);
// âûñîòû íå ñîâïàäàþò
if LastObjectHeight <> APointObject.ActualZOrder[1] then
begin
CreateRaiseOnPointObject(APointObject, LastObjectHeight);
for i := 0 to TracesList.Count - 1 do
begin
JoinedLine := TOrthoLine(TracesList[i]);
RaiseLineOnHeight(JoinedLine, LastObjectHeight, TracesList);
end;
end;
end
else
// ÝÒÎ ÂÅÐØÈÍÀ Ñ-Ï
if (AConnector.FConnRaiseType <> crt_None) then
begin
RaiseType := AConnector.FConnRaiseType;
SnapPointObjectToConnector(APointObject, AConnector);
ObjFromRaise.FConnRaiseType := crt_None;
ObjFromRaise.FObjectFromRaise := nil;
AConnector.FConnRaiseType := crt_None;
AConnector.FObjectFromRaise := nil;
APointObject.FConnRaiseType := RaiseType;
APointObject.FObjectFromRaise := ObjFromRaise;
if AConnector.LockMove = True then
AConnector.LockMove := False;
end
else
// ÝÒÎ ÎÁÚÅÊÒ ÍÀ ÊÎÒÎÐÎÌ Ñ-Ï
if RaiseConn <> nil then
begin
if (APointObject.ActualZOrder[1] = RaiseConn.ActualZOrder[1]) then
begin
// ïåðåñîåäèíèòü ê ñ-ï
if RaiseConn.ConnectorType = ct_clear then
begin
SnapPointObjectToConnector(APointObject, RaiseConn);
AConnector.FConnRaiseType := crt_None;
AConnector.FObjectFromRaise := nil;
RaiseConn.FConnRaiseType := crt_None;
RaiseConn.FObjectFromRaise := nil;
APointObject.FConnRaiseType := crt_OnFloor;
APointObject.FObjectFromRaise := AConnector;
end;
end
else
begin
AConnector.ActualZOrder[1] := APointObject.ActualZOrder[1];
SnapPointObjectToConnector(APointObject, AConnector);
if RaiseConn <> nil then
RaiseConn.FObjectFromRaise := APointObject;
if RaiseLine <> nil then
RaiseLine.FObjectFromRaisedLine := APointObject;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckingSnapPointObjectToConnector', E.Message);
end;
BaseEndUpdate;
end;
function AutoDivideLine(ALine: TOrthoLine): TConnectorObject;
var
Conn1, Conn2: TConnectorObject;
JoinConn1, JoinConn2: TConnectorObject;
begin
Result := nil;
Conn1 := TConnectorObject(ALine.JoinConnector1);
Conn2 := TConnectorObject(ALine.JoinConnector2);
if (Conn1.JoinedConnectorsList.Count > 0) and (Conn2.JoinedConnectorsList.Count > 0) then
begin
JoinConn1 := TConnectorObject(Conn1.JoinedConnectorsList[0]);
JoinConn2 := TConnectorObject(Conn2.JoinedConnectorsList[0]);
if (JoinConn1.FHouse <> nil) and (JoinConn2.FHouse <> nil) and (JoinConn1.FHouse = JoinConn2.FHouse) then
Result := DivideLineSimple(ALine);
end;
end;
function DivideLine(ALine: TOrthoLine): TConnectorObject;
//var
// DivideConn: TConnectorObject;
// DividePoints: TDoublePoint;
// i: integer;
// JoinedLine: TOrthoLine;
begin
Result := nil;
BaseBeginUpdate;
BeginDevideLine;
//31.01.2011 try
// DividePoints.x := (ALine.ActualPoints[1].x + ALine.ActualPoints[2].x) / 2;
// DividePoints.y := (ALine.ActualPoints[1].y + ALine.ActualPoints[2].y) / 2;
// DivideConn := TConnectorObject.Create(DividePoints.x, DividePoints.y, ALine.ActualZOrder[1], ALine.LayerHandle, mydsNormal, GCadForm.PCad);
// DivideConn.ConnectorType := ct_Clear;
// GCadForm.PCad.AddCustomFigure (GLN(ALine.LayerHandle), DivideConn, false);
// SnapConnectorToOrtholine(DivideConn, ALine);
// ALine.CalculLength := ALine.LengthCalc;
// ALine.LineLength := ALine.CalculLength;
// ALine.UpdateLengthTextBox(false, true);
// ALine.ReCreateNotesGroup;
// ALine.ReCreateDrawFigureBlock;
// RefreshCAD(GCadForm.PCad);
// Result := DivideConn;
// except
// on E: Exception do addExceptionToLogEx('U_Common.DivideLine', E.Message);
// end;
Result := DivideLineSimple(ALine);
EndDevideLine;
BaseEndUpdate;
end;
function DivideLineSimple(ALine: TOrthoLine; ADivPt: PDoublePoint): TConnectorObject;
var
DivideConn: TConnectorObject;
DividePoints: TDoublePoint;
i: integer;
JoinedLine: TOrthoLine;
FigureSnap: TFigure;
begin
Result := nil;
try
if ADivPt <> nil then
DividePoints := ADivPt^
else
begin
DividePoints.x := (ALine.ActualPoints[1].x + ALine.ActualPoints[2].x) / 2;
DividePoints.y := (ALine.ActualPoints[1].y + ALine.ActualPoints[2].y) / 2;
end;
FigureSnap := GFigureSnap;
DivideConn := TConnectorObject.Create(DividePoints.x, DividePoints.y, ALine.ActualZOrder[1], ALine.LayerHandle, mydsNormal, GCadForm.PCad);
DivideConn.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(ALine.LayerHandle), DivideConn, false);
SnapConnectorToOrtholine(DivideConn, ALine);
ALine.CalculLength := ALine.LengthCalc;
ALine.LineLength := ALine.CalculLength;
ALine.UpdateLengthTextBox(false, true);
ALine.ReCreateNotesGroup;
ALine.ReCreateDrawFigureBlock;
RefreshCAD(GCadForm.PCad);
Result := DivideConn;
GFigureSnap := FigureSnap; //29.07.2013 íà SnapConnectorToOrtholine á³âàåò ñáðàñ³âàåòñÿ GFigureSnap
except
on E: Exception do addExceptionToLogEx('U_Common.DivideLineSimple', E.Message);
end;
end;
procedure ReCalcZCoordSnapObjects(AConnector: TConnectorObject);
var
i, j: integer;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
begin
try
// ñîåäèíèòåëü
if AConnector.ConnectorType = ct_Clear then
begin
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]);
if JoinedLine.JoinConnector1 = AConnector then
JoinedLine.ActualZOrder[1] := AConnector.ActualZOrder[1];
if JoinedLine.JoinConnector2 = AConnector then
JoinedLine.ActualZOrder[2] := AConnector.ActualZOrder[1];
JoinedLine.UpdateLengthTextBox(false, true);
end;
end
else
// ÐÒ
begin
for i := 0 to AConnector.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(AConnector.JoinedConnectorsList[i]);
// Tolik
// JoinedConn.ActualZOrder[1] := AConnector.ActualZOrder[1];
JoinedConn.ActualZOrder[1] := TConnectorObject(AConnector.JoinedConnectorsList[i]).ActualZOrder[1];
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
if JoinedLine.JoinConnector1 = JoinedConn then
JoinedLine.ActualZOrder[1] := JoinedConn.ActualZOrder[1];
if JoinedLine.JoinConnector2 = JoinedConn then
JoinedLine.ActualZOrder[2] := JoinedConn.ActualZOrder[1];
JoinedLine.UpdateLengthTextBox(false, true);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ReCalcZCoordSnapObjects', E.Message);
end;
end;
Function OrthoLineDetect(AOrthoLine: TFigure): Boolean;
begin
//02.11.2011 try
Result := False;
if CheckFigureByClassName(AOrthoLine, cTOrthoLine) then
Result := True;
//02.11.2011 except
//02.11.2011 Result := False;
//02.11.2011 end;
end;
Function ConnectorDetect(AConnector: TFigure): Boolean;
begin
try
Result := False;
if CheckFigureByClassName(AConnector, cTConnectorObject) then
Result := True;
except
Result := False;
end;
end;
function SCSClassDetect(ASCSObject: TFigure): Boolean;
begin
Result := False;
if CheckFigureByClassName(ASCSObject, cTOrthoLine) then
Result := True
else if CheckFigureByClassName(ASCSObject, cTConnectorObject) then
Result := True
else if CheckFigureByClassName(ASCSObject, cTTextMod) then
Result := True
else if CheckFigureByClassName(ASCSObject, cTFigureGrpMod) then
Result := True
else if CheckFigureByClassName(ASCSObject, cTFigureGrpNotMod) then
Result := True
else if CheckFigureByClassName(ASCSObject, cTFrame) then
Result := True
else if CheckFigureByClassName(ASCSObject, cTRichTextMod) then
Result := True
else if CheckFigureByClassName(ASCSObject, cTCabinet) then
Result := True
else if CheckFigureByClassName(ASCSObject, cTCabinetExt) then
Result := True
else if CheckFigureByClassName(ASCSObject, cTCabinetNumber) then
Result := True
else if CheckFigureByClassName(ASCSObject, cTPlanObject) then
Result := True
else if CheckFigureByClassName(ASCSObject, cTPlanConnector) then
Result := True
else if CheckFigureByClassName(ASCSObject, cTPlanTrace) then
Result := True;
end;
// òî÷. îáúåêòîâ
Procedure SetFullnessTypeForConnector(AID_List, AID_Figure: Integer; AFullnessType: TComponInterfacesFullness);
var
i: integer;
vList: TF_CAD;
vFigure: TConnectorObject;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
vFigure := TConnectorObject(GetFigureByID(vList, AID_Figure));
if vFigure <> nil then
begin
vFigure.FConnFullness := AFullnessType;
end
else
begin
vFigure := TConnectorObject(GetFigureByIDInSCSFigureGroups(vList, AID_Figure));
if vFigure <> nil then
vFigure.FConnFullness := AFullnessType;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetFullnessTypeForConnector', E.Message);
end;
end;
// êàáåëåé
Procedure SetFullnessTypeForCable(AID_List, AID_Figure: Integer; ASide: Integer; AFullnessType: TComponInterfacesFullness);
var
i: integer;
vList: TF_CAD;
vFigure: TOrthoLine;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
vFigure := TOrthoLine(GetFigureByID(vList, AID_Figure));
if vFigure <> nil then
begin
if ASide = 1 then
vFigure.FCableFullnessSide1 := AFullnessType;
if ASide = 2 then
vFigure.FCableFullnessSide2 := AFullnessType;
end
else
begin
vFigure := TOrthoLine(GetFigureByIDInSCSFigureGroups(vList, AID_Figure));
if vFigure <> nil then
begin
if ASide = 1 then
vFigure.FCableFullnessSide1 := AFullnessType;
if ASide = 2 then
vFigure.FCableFullnessSide2 := AFullnessType;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetFullnessTypeForCable', E.Message);
end;
end;
Procedure SetClosedTypeForCableChannel(AID_List, AID_Figure: Integer; ASide: Integer; AClosedType: TComponInterfacesFullness);
var
i: integer;
vList: TF_CAD;
vFigure: TOrthoLine;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
vFigure := TOrthoLine(GetFigureByID(vList, AID_Figure));
if vFigure <> nil then
begin
if ASide = 1 then
vFigure.FCableChannelClosedSide1 := AClosedType;
if ASide = 2 then
vFigure.FCableChannelClosedSide2 := AClosedType;
end
else
begin
vFigure := TOrthoLine(GetFigureByIDInSCSFigureGroups(vList, AID_Figure));
if vFigure <> nil then
begin
if ASide = 1 then
vFigure.FCableChannelClosedSide1 := AClosedType;
if ASide = 2 then
vFigure.FCableChannelClosedSide2 := AClosedType;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetClosedTypeForCableChannel', E.Message);
end;
end;
Procedure SetTraceStyle(AID_List, AID_Figure: Integer; ATraceStyle: TTraceStyle);
var
i: integer;
vLine: TOrthoLine;
vList: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
vLine := TOrthoLine(GetFigureByID(vList, AID_Figure));
if vLine <> nil then
begin
vLine.FLineType := ATraceStyle;
end
else
begin
vLine := TOrthoLine(GetFigureByIDInSCSFigureGroups(vList, AID_Figure));
if vLine <> nil then
vLine.FLineType := ATraceStyle;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetTraceStyle', E.Message);
end;
end;
// êàáåëüíûõ êàíàëîâ
Procedure SetFullnessTypeForCableChannel(AID_List, AID_Figure: Integer; AFullnessType: TComponInterfacesFullness);
var
i: integer;
vList: TF_CAD;
vFigure: TOrthoLine;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
vFigure := TOrthoLine(GetFigureByID(vList, AID_Figure));
if vFigure <> nil then
begin
vFigure.FCableChannelFullness := AFullnessType;
end
else
begin
vFigure := TOrthoLine(GetFigureByIDInSCSFigureGroups(vList, AID_Figure));
if vFigure <> nil then
vFigure.FCableChannelFullness := AFullnessType;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetFullnessTypeForCableChannel', E.Message);
end;
end;
// ÐÅÆÈÌ ÊËÈÊÀ - ÑÎÇÄÀÂÀÒÜ ÎÁÚÅÊÒ/ÊÎÌÏËÅÊÒÓÞÙÓÞ
procedure CreateOnClickMode(ASnapFigure: TFigure; ALastSCSCompon: TSCSComponent; X, Y: Double);
var
DropFigure: TFigure;
StateType: TCompStateType;
ComponID: integer;
i, j: integer;
JoinedTrace: TOrthoLine;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
isConnected: Boolean;
NBComponent: TSCSComponent;
SavedDragX, SavedDragY: Double;
ConnComponID: Integer;
begin
if GIsProgress then
begin
exit;
end;
DropFigure := nil;
NBComponent := nil;
StateType := stProjectible;
BeginProgress;
try
// óáðàòü âûäåëåíûå îáüåêòû ñî ñëîÿ ïîäëîæêè
//GCadForm.PCad.DeselectAll(1);
// ïðè òïóñêàíèè êîìïîíåíòû - âîññîçäàòü åå íà CAD
GListNode := Nil;
ComponID := 0;
ConnComponID := 0;
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
NBComponent := F_NormBase.GSCSBase.SCSComponent;
// ñîçäàòü ôèãóðó íà CAD
DropFigure := GetComponentFromNormBase(X, Y, NBComponent, ASnapFigure, StateType);
// ñêîïèðîâàíèå êîìïîíåíòó NormBase -> ProjectManager
if DropFigure <> nil then
begin
ComponID := CopyComponentToPrjManager(GListNode, DropFigure.ID, GCadForm.FCADListID, ALastSCSCompon, True, True);
// Äðîïíóëñÿ òî÷å÷íûé îáüåêò!
if CheckFigureByClassName(DropFigure, cTConnectorObject) then
begin
ConnComponID := ComponID;
// ïîëîæèòü òî÷å÷íûé îáúåêò íà äðóãîé îáüåêò
if ASnapFigure <> Nil then
begin
// íà îðòîëèíèþ
if CheckFigureByClassName(ASnapFigure, cTOrthoLine) then
begin
CheckingSnapPointObjectToOrthoLine(TConnectorObject(DropFigure), TOrthoLine(ASnapFigure));
end
// íà ïóñòîé êîíåêòîð
else if CheckFigureByClassName(ASnapFigure, cTConnectorObject) then
begin
CheckingSnapPointObjectToConnector(TConnectorObject(DropFigure), TConnectorObject(ASnapFigure));
end;
end;
SetConnObjectSelectHightPriority(TConnectorObject(DropFigure)); //#From Oleg# //29.09.2010
end;
end
else
// êîìïîíåíòà(û) (îðòîëèíèÿ!!!) âáðàñûâàåòüñÿ â òðàññó!
if (DropFigure = Nil) and (ASnapFigure <> nil) then
begin
if CheckFigureByClassName(ASnapFigure, cTConnectorObject) and (TConnectorObject(ASnapFigure).ConnectorType <> ct_clear) then
ComponID := CopyComponentToSCSObject(ASnapFigure.ID, TSCSComponent(ALastSCSCompon).ID, True);
if CheckFigureByClassName(ASnapFigure, cTOrthoLine) then
begin
ComponID := CopyComponentToSCSObject(ASnapFigure.ID, TSCSComponent(ALastSCSCompon).ID, True);
AutoConnectOnAppendCable(GCadForm.FCADListID, TOrthoLine(ASnapFigure).ID);
end;
end;
// *UNDO*
GCadForm.FCanSaveForUndo := True;
// óáðàòü âûäåëåíèå âñåõ âûäåëåííûõ ôèãóð!
if GPrevFigureSnap <> nil then
begin
TConnectorObject(DropFigure).DrawSnapFigures(GPrevFigureSnap, False);
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
if SCSClassDetect(TFigure(GCadForm.PCad.Selection[i])) then
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) and (TFigure(GCadForm.PCad.Selection[i]).Selected) then
TConnectorObject(DropFigure).DrawSnapFigures(TFigure(GCadForm.PCad.Selection[i]), False);
end;
end;
if DropFigure <> nil then
DropFigure.Select
else
if ASnapFigure <> nil then
ASnapFigure.Select;
ASnapFigure := Nil;
GPrevFigureSnap := Nil;
RefreshCAD(GCadForm.PCad);
GListNode := Nil;
GDraggedFigureZOrder := -1;
// DestroyShadowObject;
except
on E: Exception do addExceptionToLogEx('U_Common.CreateOnClickMode', E.Message);
end;
EndProgress;
if ConnComponID <> 0 then
AskMarkInCreateObjectOnClick(GCadForm, ConnComponID);
//30.06.2010
if (DropFigure = nil) and IsArchComponByIsLine(NBComponent.IsLine) then
begin
SavedDragX := GCadForm.DragX;
SavedDragY := GCadForm.DragY;
try
GCadForm.DragX := X;
GCadForm.DragY := Y;
CreateArchObjWizard(GCadForm.FCADListID, NBComponent, GCadForm, nil);
finally
GCadForm.DragX := SavedDragX;
GCadForm.DragY := SavedDragY;
end;
end;
end;
procedure AskMarkInCreateObjectOnClick(aCAD: TF_CAD; aComponID: Integer);
var
SCSList: TSCSList;
SCSCompon: TSCSComponent;
InputMarkRes: Integer;
PrevMark: string;
begin
SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(aCAD.FCADListID);
if SCSList <> nil then
if SCSList.FNewComponNameMarkAsk then
begin
if GIsProgress then
begin
//PauseProgress(true);
//Application.ProcessMessages;
end;
SCSCompon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(aComponID);
if SCSCompon <> nil then
begin
PrevMark := SCSCompon.NameMark;
if SCSList.FNewComponNameMarkSaved = '' then
SCSList.FNewComponNameMarkSaved := PrevMark;
end;
try
InputMarkRes := InputMark(ApplicationName, cMain_Mes141, SCSList.FNewComponNameMarkSaved);
finally
if GIsProgress then
;//PauseProgress(false);
end;
if InputMarkRes = mrOk then
begin
if trim(PrevMark) <> trim(SCSList.FNewComponNameMarkSaved) then
begin
SCSList.FNewComponNameMark := SCSList.FNewComponNameMarkSaved;
//SCSCompon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(aComponID);
if SCSCompon <> nil then
begin
SCSCompon.IsUserMark := biTrue;
SCSCompon.NameMark := SCSList.FNewComponNameMark;
SCSCompon.ApplyChanges;
end;
end
else
begin
SCSList.FNewComponNameMarkSaved := '';
end;
end
else
begin
SCSList.FNewComponNameMarkSaved := '';
if InputMarkRes = mrIgnore then
begin
SCSList.FNewComponNameMark := '';
SCSList.FNewComponNameMarkAsk := false;
end;
end;
end;
end;
procedure SetIndexToFigure(AID_List, AID_Figure: Integer; AIndex: Integer);
var
CAD_Figure: TFigure;
vList: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
CAD_Figure := GetFigureByID(vList, AID_Figure);
if CAD_Figure <> nil then
begin
if CheckFigureByClassName(CAD_Figure, cTConnectorObject) then
TConnectorObject(CAD_Figure).FIndex := AIndex
else if CheckFigureByClassName(CAD_Figure, cTOrthoLine) then
TOrthoLine(CAD_Figure).FIndex := AIndex;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetIndexToFigure', E.Message);
end;
end;
procedure SetShowNameTypeInCAD(AShowType: TShowType);
var
i: integer;
CADFigure: TFigure;
ObjParams: TObjectParams;
begin
try
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
CADFigure := TFigure(GCadForm.PCad.Figures[i]);
if CADFigure <> nil then
begin
if CheckFigureByClassName(CADFigure, cTConnectorObject) then
begin
ObjParams := GetFigureParams(CADFigure.ID);
TConnectorObject(CADFigure).Name := ObjParams.Name;
TConnectorObject(CADFigure).FIndex := ObjParams.MarkID;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetShowNameTypeInCAD', E.Message);
end;
end;
// óñòàíîâèòü ïîäïèñü ê òî÷å÷íîìó îáüåêòó
procedure SetConnCaptionsInCAD(AID_List, AConnID: Integer; ACaption: TStringList);
var
i: integer;
AFigure: TFigure;
SavedCadForm: TF_CAD;
vList: TF_CAD;
FName: string;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
SavedCadForm := GCadForm;
GCadForm := vList;
AFigure := GetFigureByID(vList, AConnID);
if AFigure <> nil then
begin
if CheckFigureByClassName(AFigure, cTConnectorObject) then
begin
// åñëè âûíîñêà íå ìåíÿëàñü þçåðîì
if not TConnectorObject(AFigure).FIsCaptionsChanged then
begin
if TConnectorObject(AFigure).OutTextCaptions.Count > 0 then
FName := TConnectorObject(AFigure).OutTextCaptions[0]
else
FName := '';
TConnectorObject(AFigure).OutTextCaptions.Clear;
TConnectorObject(AFigure).OutTextCaptions.Add(FName);
for i := 0 to ACaption.Count - 1 do
TConnectorObject(AFigure).OutTextCaptions.Add(ACaption[i]);
TConnectorObject(AFigure).ReCreateCaptionsGroup(false, true);
end;
end
else if CheckFigureByClassName(AFigure, cTOrthoLine) then //28.08.2013 - Ïðåäóñìàîòðèâàåì ïîäïèñè ñ ìàðêðèðîâêîé ëèíåéíûõ êîìïîíåíòîâ
begin
// Çàïîìèíàåì äëèíó
FName := '';
if TOrthoLine(AFigure).OutTextCaptions.Count > 0 then
FName := TOrthoLine(AFigure).OutTextCaptions[0];
//
TOrthoLine(AFigure).OutTextCaptions.Assign(ACaption);
// Âîññòàíîâèòü äëèíó
TOrthoLine(AFigure).OutTextCaptions.Insert(0, FName); //åñëè ïóñòàÿ äëèíà, äî âñå ðàâíî äîáàâëÿåì ïóñòóþ ñòðîêó, ÷òîáû íå íàêëàäûâàëñÿ òåêñò íà ÓÃÎ
TOrthoLine(AFigure).ReCreateCaptionsGroup(false, true);
end;
end;
GCadForm := SavedCadForm;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetConnCaptionsInCAD', E.Message);
end;
end;
// óñòàíîâèòü âûíîñêó íà òî÷å÷íîì îáúåêòå
procedure SetConnNotesInCAD(AID_List, AConnID: Integer; ANote: TStringList);
var
i: integer;
AFigure: TFigure;
vList: TF_CAD;
SavedCadForm: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
SavedCadForm := GCadForm;
GCadForm := vList;
AFigure := GetFigureByID(GCadForm, AConnID);
if AFigure <> nil then
begin
if CheckFigureByClassName(AFigure, cTConnectorObject) then
begin
// åñëè âûíîñêà íå ìåíÿëàñü þçåðîì
if not TConnectorObject(AFigure).FIsNotesChanged then
begin
TConnectorObject(AFigure).OutTextNotes.Clear;
for i := 0 to ANote.Count - 1 do
TConnectorObject(AFigure).OutTextNotes.Add(ANote[i]);
TConnectorObject(AFigure).ReCreateNotesGroup;
end;
end;
end;
GCadForm := SavedCadForm;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetConnNotesInCAD', E.Message);
end;
end;
// óñòàíîâèòü âûíîñêó íà ëèíåéíîì îáúåêòå
procedure SetLineNotesInCAD(AID_List, ALineID: Integer; ANote: TStringList);
var
i: integer;
Line: TOrthoLine;
vList: TF_CAD;
SavedCadForm: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
SavedCadForm := GCadForm;
GCadForm := vList;
Line := TOrthoLine(GetFigureByID(GCadForm, ALineID));
if Line <> nil then
begin
// åñëè âûíîñêà íå ìåíÿëàñü þçåðîì
if not Line.FIsNotesChanged then
begin
Line.OutTextNotes.Clear;
for i := 0 to ANote.Count - 1 do
Line.OutTextNotes.Add(ANote[i]);
Line.ReCreateNotesGroup;
end;
end;
GCadForm := SavedCadForm;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetLineNotesInCAD', E.Message);
end;
end;
procedure SetLineCaptionsInCAD(AID_List, ALineID: Integer);
var
i: integer;
Line: TOrthoLine;
vList: TF_CAD;
SavedCadForm: TF_CAD;
PairStr: string;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
SavedCadForm := GCadForm;
GCadForm := vList;
if GCadForm.FShowLineCaptionsType = skExternalSCS then
begin
Line := TOrthoLine(GetFigureByID(GCadForm, ALineID));
if Line <> nil then
begin
// åñëè ïîäïèñü íå ìåíÿëàñü þçåðîì
if not Line.FIsCaptionsChanged then
begin
if Line.OutTextCaptions.Count >= 1 then
begin
PairStr := GetPairCountFromTrace(GCadForm.FCADListID, Line.ID);
Line.OutTextCaptions[0] := PairStr;
end;
Line.ReCreateCaptionsGroup(True, true);
end;
end;
end;
GCadForm := SavedCadForm;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetLineCaptionsInCAD', E.Message);
end;
end;
procedure TraceCableChannelBySelectedLines(CableChannelID: Integer);
var
i, j, k, lcount: Integer;
ComponID: Integer;
SelFigure: TFigure;
SelLine: TOrthoLine;
mess: string;
WithRaise: Boolean;
JoinConn1, JoinConn2: TConnectorObject;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
PointObject: TConnectorObject;
RaiseLine: TOrthoLine;
LinesList, SelList, RaisesList, ListOfLists: TList;
vList: TF_CAD;
SavedGcadForm: TF_CAD;
QExist: Boolean;
TraceIDs: TIntList;
GetRaiseLine: TOrthoLine;
begin
BeginProgress;
try
// îïðåäåëèòü ñïèñîê ëèñòîâ ãäå åñòü âûäåëåííûå
ListOfLists := TList.Create;
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
vList := TF_CAD(FSCS_Main.MDIChildren[i]);
if vList.FListType = lt_Normal then
begin
for j := 0 to vList.PCad.SelectedCount - 1 do
if CheckFigureByClassName(TFigure(vList.PCad.Selection[j]), cTOrthoLine) then
begin
ListOfLists.Add(vList);
Break;
end;
end;
end;
// *UNDO*
if ListOfLists.Count > 0 then
begin
if GCadForm.FCanSaveForUndo then
begin
if ListOfLists.Count = 1 then
GCadForm.SaveForUndo(uat_None, True, False)
else
SaveForProjectUndo(ListOfLists, True, False);
end;
end;
// ïðîëîæèòü ïî âûäåëåííûì ïî âñåì ëèñòàì
WithRaise := False;
QExist := False;
for lcount := 0 to ListOfLists.Count - 1 do
begin
vList := TF_CAD(ListOfLists[lcount]);
SavedGcadForm := GCadForm;
GCadForm := vList;
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
LinesList := TList.Create;
SelList := TList.Create;
RaisesList := TList.Create;
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
SelFigure := TFigure(GCadForm.PCad.Selection[i]);
if SelFigure.Selected then //25.06.2013 - ïîñëå SelectAll âûïîëíÿåòñÿ TF_CAD.PCadSelectionChange, ñ êîòîðîãî âûçûâàåòñÿ UnSelectFiguresOnSelectedChange,
//ãäå ïðîèñõîäèò Deselect ñ-ï. Åñëè SelectAll âûçâàí ïî Crtl-A, òî âñå ñîáûòèÿ óñïåâàþò âûïîëíèòñÿ, åñëè âðó÷íóþ áûë âûçîâ SelectAll,
//òî PCad.Selection íå ñîîòâåòñòâóåò äåéñòâèòåëíîñòè
if CheckFigureByClassName(SelFigure, cTOrthoLine) then
SelList.Add(SelFigure);
end;
// ïðîâåðèòü åñòü ëè ñ-ï ÷åðåç êîòîðûå ìîæíî ïðîêëàäûâàòü
for k := 0 to SelList.Count - 1 do
begin
SelLine := TOrthoLine(SelList[k]);
JoinConn1 := TConnectorObject(SelLine.JoinConnector1);
JoinConn2 := TConnectorObject(SelLine.JoinConnector2);
// JoinConn1
for i := 0 to JoinConn1.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(JoinConn1.JoinedOrtholinesList[i]).FIsRaiseUpDown then
if CheckNoFigureInList(TOrthoLine(JoinConn1.JoinedOrtholinesList[i]), RaisesList) and
CheckNoFigureInList(TOrthoLine(JoinConn1.JoinedOrtholinesList[i]), SelList) then
RaisesList.Add(TOrthoLine(JoinConn1.JoinedOrtholinesList[i]));
if JoinConn1.JoinedConnectorsList.Count > 0 then
begin
PointObject := TConnectorObject(JoinConn1.JoinedConnectorsList[0]);
for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(PointObject.JoinedConnectorsList[i]);
if JoinedConn <> JoinConn1 then
begin
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then
if CheckNoFigureInList(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]), RaisesList) and
CheckNoFigureInList(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]), SelList) then
RaisesList.Add(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]));
end;
end;
end;
// JoinConn2
for i := 0 to JoinConn2.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(JoinConn2.JoinedOrtholinesList[i]).FIsRaiseUpDown then
if CheckNoFigureInList(TOrthoLine(JoinConn2.JoinedOrtholinesList[i]), RaisesList) and
CheckNoFigureInList(TOrthoLine(JoinConn2.JoinedOrtholinesList[i]), SelList) then
RaisesList.Add(TOrthoLine(JoinConn2.JoinedOrtholinesList[i]));
if JoinConn2.JoinedConnectorsList.Count > 0 then
begin
PointObject := TConnectorObject(JoinConn2.JoinedConnectorsList[0]);
for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(PointObject.JoinedConnectorsList[i]);
if JoinedConn <> JoinConn2 then
begin
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then
if CheckNoFigureInList(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]), RaisesList) and
CheckNoFigureInList(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]), SelList) then
RaisesList.Add(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]));
end;
end;
end;
end;
// c-ï åñòü!
if not QExist then
begin
if RaisesList.Count > 0 then
begin
mess := cCommon_Mes20;
if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cCommon_Mes21, MB_YESNO) = IDYes then
WithRaise := True
else
WithRaise := False;
QExist := True;
end;
end;
// âìåñòå ñ ñ-ï
if WithRaise then
begin
for i := 0 to SelList.Count - 1 do
begin
SelLine := TOrthoLine(SelList[i]);
LinesList.Add(SelLine);
end;
for i := 0 to RaisesList.Count - 1 do
begin
SelLine := TOrthoLine(RaisesList[i]);
LinesList.Add(SelLine);
end;
end
else
begin
for i := 0 to SelList.Count - 1 do
begin
SelLine := TOrthoLine(SelList[i]);
LinesList.Add(SelLine);
end;
end;
for i := 0 to LinesList.Count - 1 do
begin
ProcessMessagesEx;
SelFigure := TFigure(LinesList[i]);
ComponID := CopyComponentToSCSObject(SelFigure.ID, CableChannelID);
AutoConnectOnAppendCable(GCadForm.FCADListID, SelFigure.ID);
// åñëè ýòî ì-ý ñ-ï, òî íàéòè òðàññó íà äðóãîì ëèñòå
if TOrthoLine(SelFigure).FIsRaiseUpDown then
begin
GetRaiseLine := GetBetweenFloorRaiseLine(TOrthoLine(SelFigure));
if GetRaiseLine <> nil then
begin
TraceIDs := TIntList.Create;
TraceIDs.Add(TOrthoLine(SelFigure).ID);
TraceIDs.Add(GetRaiseLine.ID);
ConnectObjectsInPMByWay(TraceIDs, nil, nil, nil);
FreeAndNil(TraceIDs);
end;
end;
end;
if RaisesList <> nil then
FreeAndNil(RaisesList);
if SelList <> nil then
FreeAndNil(SelList);
if LinesList <> nil then
FreeAndNil(LinesList);
end;
GCadForm := SavedGcadForm;
end;
if ListOfLists <> nil then
FreeAndNil(ListOfLists);
except
on E: Exception do addExceptionToLogEx('U_Common.TraceCableChannelBySelectedLines', E.Message);
end;
EndProgress;
end;
function IsSelectedLinesExist: Boolean;
var
i: integer;
begin
Result := False;
try
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then
Result := True;
except
on E: Exception do addExceptionToLogEx('U_Common.IsSelectedLinesExist', E.Message);
end;
end;
function IsSelectedFigure(aListID, aFigureID: Integer): Boolean;
var
Fig: TFigure;
begin
Result := false;
Fig := GetFigureObjectByID(aListID, aFigureID);
if Fig <> nil then
Result := Fig.Selected;
end;
function GetCoordXWithSnapToGrid(X: Double): Double;
var
BaseX: Double;
GridStep: Double;
begin
Result := 0;
try
GridStep := GCadForm.PCad.GridStep;
BaseX := Round(X / GridStep);
Result := BaseX * GridStep;
except
on E: Exception do addExceptionToLogEx('U_Common.GetCoordXWithSnapToGrid', E.Message);
end;
end;
function GetCoordYWithSnapToGrid(Y: Double): Double;
var
BaseY: Double;
GridStep: Double;
begin
Result := 0;
try
GridStep := GCadForm.PCad.GridStep;
BaseY := Round(Y / GridStep);
Result := BaseY * GridStep;
except
on E: Exception do addExceptionToLogEx('U_Common.GetCoordYWithSnapToGrid', E.Message);
end;
end;
function GetCoordsWithSnapToGrid(X, Y: Double): TDoublePoint;
//var
// BaseX, BaseY: Double;
// GridStep: Double;
begin
try
//01.10.2013
//Result := DoublePoint(0, 0);
//GridStep := GCadForm.PCad.GridStep;
//BaseX := Round(X / GridStep);
//BaseY := Round(Y / GridStep);
//Result.x := BaseX * GridStep;
//Result.y := BaseY * GridStep;
Result := DoublePoint(x, y);
GCadForm.PCad.SnapToGrid(Result.x, Result.y);
except
on E: Exception do addExceptionToLogEx('U_Common.GetCoordsWithSnapToGrid', E.Message);
end;
end;
function IsClickOnFigure: Boolean;
var
GridStep: Double;
begin
Result := False;
try
// íåò ïðèâÿçêè ê ñåòêå
if not FSCS_Main.aSnaptoGrid.Checked then
begin
if (GMouseDownPos.x = GCurrMousePos.x) and (GMouseDownPos.y = GCurrMousePos.y) then
Result := True;
end
else
// åñòü ïðèÿçêà ê ñåòêå
begin
GridStep := GCadForm.PCad.GridStep;
if (abs(GMouseDownPos.x - GCurrMousePos.x) < GridStep) and
(abs(GMouseDownPos.y - GCurrMousePos.y) < GridStep) then
Result := True;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.IsClickOnFigure', E.Message);
end;
end;
procedure SetConnNameInCaptionOnCAD(AConnector: TConnectorObject);
var
i: integer;
CaptionsLHandle: Integer;
FullName: String;
begin
try
FullName := AConnector.Name + IntToStr(AConnector.FIndex);
if AConnector.OutTextCaptions.Count > 0 then
AConnector.OutTextCaptions[0] := FullName
else
AConnector.OutTextCaptions.Add(FullName);
AConnector.ReCreateCaptionsGroup(true, true);
except
on E: Exception do addExceptionToLogEx('U_Common.SetConnNameInCaptionOnCAD', E.Message);
end;
end;
Procedure AutoTraceCableFromNB(AID_Cable: Integer; ACable: TSCSComponent; aFromDropConnObj: Boolean=false; aShowFirstMsg: Boolean=true; aSaveForUndo: Boolean=true;
aNeedShowAutoTraceType: boolean = True; aFromDrop: boolean = False);
var
i, j, k: integer;
ComponID: Integer;
IsAnyRTSelected: Boolean;
mess: String;
aEndPointName: string;
TracedList: TList;
WasEndPoint: boolean;
//02.07.2013
FiguresList: TList;
//RackCount: Integer;
//BoxCount: Integer;
//WACount: Integer;
//RackPortCount, BoxPortCount, WAPortCount: Integer;
ptrTrFigInfo: PTracingFiguresInfo;
ExistsBoxAndRack: Boolean;
CurrentWA: TConnectorObject;
WAList: TF_CAD;
SCSList: TSCSList;
SCSObj: TSCSCatalog;
SCSCompon: TSCSComponent;
//TempInterfaces: TSCSInterfaces;
TmpPortCount: Integer;
FigureID: integer;
SCSComponTmp: TSCSComponent;
SCSCatalog: TSCSCatalog;
isEndObjectRack: boolean;
BoxFigure: TFigure;
isEndObjectBox: Boolean;
isSnapObjectRack: boolean;
isSnapObjectBox: Boolean;
resM: integer;
begin
ptrTrFigInfo := nil;
try
try
WasEndPoint := True;
if GEndPoint = nil then
begin
// ÊÎ ÂÛÁÐÀÒÜ
WasEndPoint := False;
if GIsProgress {and aFromDrop} then
PauseProgress(True);
try
F_EndPoints.Execute;
finally
if GIsProgress {and aFromDrop} then
PauseProgress(False);
end;
end;
if GEndPoint <> nil then
begin
TracedList := TList.Create;
// ïåðåãíàòü âûäåëåííûå îáúåêòû â ëèñò
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
TracedList.Add(TFigure(GCadForm.PCad.Selection[i]));
end;
// ïðîâåðèòü ìîæíî ëè òðàññèðîâàòü ïî âûáðàííûì èëè òîëüêî âî âñåì
IsAnyRTSelected := False;
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
If CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then
If TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_Clear then
if TConnectorObject(GCadForm.PCad.Selection[i]) <> GEndPoint then
IsAnyRTSelected := True;
end;
if IsAnyRTSelected then
begin
if aNeedShowAutoTraceType then
begin
if GIsProgress then
PauseProgress(True);
try
resM := F_AutoTraceType.ShowModal;
finally
if GIsProgress then
PauseProgress(False);
end;
if resM = mrOK then
begin
if F_AutoTraceType.rbTraceBySelected.Checked then
GCadForm.FAutoTraceBySelected := True;
if F_AutoTraceType.rbTraceByAll.Checked then
GCadForm.FAutoTraceBySelected := False;
end
else
Exit;
end
else
GCadForm.FAutoTraceBySelected := True;
end
else
begin
if aShowFirstMsg then
begin
aEndPointName := GetFigureFirstComponentName(GEndPoint.ID);
mess := cMain_Mes34 + aEndPointName + #13#10 + #13#10 + cMain_Mes35;
if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes36, MB_OK) = IDOk then
GCadForm.FAutoTraceBySelected := False
else
Exit;
end
else
GCadForm.FAutoTraceBySelected := False
end;
//02.07.2013 - ñïèñîê ñ îá¿åêòàìè äëÿ òðàññèðîâêè
FiguresList := nil;
if not GCadForm.FAutoTraceBySelected then
FiguresList := GCadForm.PCad.Figures
else
FiguresList := TracedList;
//02.07.2013 - ÎÏÐÅÄÅËßÅÌ ÍÀËÈ×ÈÅ ØÊÀÔÀ È ÁÎÊÑÀ ÑÐÅÄÈ ÒÐÀÑÑÈÐÓÅÌÛÕ ÎÁÚÅÊÒÎÂ
ExistsBoxAndRack := false;
//RackCount := 0;
//BoxCount := 0;
//WACount := 0;
//RackPortCount := 0;
//BoxPortCount := 0;
//WAPortCount := 0;
BoxFigure := nil;
if aFromDropConnObj then
begin
GetZeroMem(ptrTrFigInfo, SizeOf(TTracingFiguresInfo));
for i := 0 to FiguresList.Count - 1 do
begin
if CheckFigureByClassName(TFigure(FiguresList[i]), cTConnectorObject) then
begin
CurrentWA := TConnectorObject(FiguresList[i]);
if CurrentWA <> nil then
begin
WAList := TF_CAD(TPowerCad(CurrentWA.Owner).Owner);
SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(WAList.FCADListID);
if SCSList <> nil then
begin
SCSObj := SCSList.GetCatalogFromReferencesBySCSID(CurrentWA.ID);
if SCSObj <> nil then
begin
for j := 0 to SCSObj.SCSComponents.Count - 1 do
begin
SCSCompon := SCSObj.SCSComponents[j];
//TempInterfaces := SCSCompon.GetInterfacesByIsPort(biTrue, true, biFalse);
TmpPortCount := GetPortsCountReadyToConnectByInterf(SCSCompon, 0, true);
if SCSCompon.ComponentType.SysName = ctsnCupboard then
begin
Inc(ptrTrFigInfo^.RackCount);
ptrTrFigInfo^.RackPortCount := ptrTrFigInfo^.RackPortCount + TmpPortCount; //TempInterfaces.Count;
end
else if SCSCompon.ComponentType.SysName = ctsnBox then
begin
BoxFigure := CurrentWA;
Inc(ptrTrFigInfo^.BoxCount);
ptrTrFigInfo^.BoxPortCount := ptrTrFigInfo^.BoxPortCount + TmpPortCount; //TempInterfaces.Count;
end
else if (SCSCompon.ComponentType.SysName = ctsnWorkPlace) or
(SCSCompon.ComponentType.SysName = ctsnSocket) or
(SCSCompon.ComponentType.SysName = ctsnModule) then
begin
Inc(ptrTrFigInfo^.WACount);
ptrTrFigInfo^.WAPortCount := ptrTrFigInfo^.WAPortCount + TmpPortCount; //TempInterfaces.Count;
end;
//FreeAndNil(TempInterfaces);
end;
end;
end;
end;
end;
end;
ExistsBoxAndRack := (ptrTrFigInfo^.RackCount > 0) and (ptrTrFigInfo^.BoxCount > 0);
end;
//*** Âûáðàòü ïîðÿäîê ïîäêëþ÷åíèÿ ïàíåëåé ñ ïîðòàìè
if Not ChoiceAutoTraceConnectOrder(nil, true, ACable, aFromDropConnObj, ptrTrFigInfo) then //07.02.2011 if Not ChoiceAutoTraceConnectOrder then
Exit; ///// EXIT /////
if ExistsBoxAndRack then
begin
if GEndPoint = GFigureSnap then // äðîïíóëè íà ÊÎ è ÊÎ íå áîêñ - ïåðåêëþ÷èòü ÊÎ íà áîêñ.
begin
isEndObjectBox := False;
if GEndPoint <> nil then
begin
FigureID := TConnectorObject(GEndPoint).ID;
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(GEndPoint.Owner.Owner).FCADListID).GetCatalogFromReferencesBySCSID(FigureID);
if SCSCatalog <> nil then
begin
for k := 0 to SCSCatalog.SCSComponents.Count - 1 do
begin
if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnBox then
begin
isEndObjectBox := true;
break;
end
end;
end;
end;
if Not isEndObjectBox then
begin
//ExistsBoxAndRack := False;
FSCS_Main.SetFigureAsEndObject(GCadForm, TConnectorObject(BoxFigure));
end;
end
else // äðîï íå íà ÊÎ - ïðîâåðèì ÷òî ÊÎ è íà ÷òî äðîïíóëè
// åñëè ÊÎ - øêàô è äðîï íà øêàô (ñîåäèíÿåì äâà øêàôà) - ñäåëàòü ExistsBoxAndRack := False;
// åñëè ÊÎ - áîêñ, è äðîï íà øêàô - îñòàâèì ïîêà êàê åñòü
// åñëè ÊÎ - øêàô è äðîï íå íà áîêñ - ñäåëàòü ExistsBoxAndRack := False; è î÷èñòèòü ñïèñîê äîáàâèòü â íåãî òîëüêî ñíàïîáæåêò
// åñëè ÊÎ - øêàô è äðîï íà áîêñ - ñäåëàòü áîêñ ÊÎ;
// åñëè ÊÎ íå áîêñ è íå øêàô - îñòàâèì ïîêà êàê åñòü òîæå
begin
isEndObjectRack := False;
isEndObjectBox := False;
isSnapObjectRack := False;
isSnapObjectBox := False;
if GEndPoint <> nil then
begin
FigureID := TConnectorObject(GEndPoint).ID;
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(GEndPoint.Owner.Owner).FCADListID).GetCatalogFromReferencesBySCSID(FigureID);
if SCSCatalog <> nil then
begin
for k := 0 to SCSCatalog.SCSComponents.Count - 1 do
begin
if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnCupboard then
begin
isEndObjectRack := true;
break;
end;
if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnBox then
begin
isEndObjectBox := true;
break;
end;
end;
end;
end;
if GFigureSnap <> nil then
begin
FigureID := TConnectorObject(GFigureSnap).ID;
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(GFigureSnap.Owner.Owner).FCADListID).GetCatalogFromReferencesBySCSID(FigureID);
if SCSCatalog <> nil then
begin
for k := 0 to SCSCatalog.SCSComponents.Count - 1 do
begin
if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnCupboard then
begin
isSnapObjectRack := true;
break;
end;
if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnBox then
begin
isSnapObjectBox := true;
break;
end;
end;
end;
end;
if isEndObjectRack and isSnapObjectRack then
begin
ExistsBoxAndRack := False;
//FSCS_Main.SetFigureAsEndObject(GCadForm, TConnectorObject(BoxFigure));
end
else
if isEndObjectRack and Not isSnapObjectBox then
begin
ExistsBoxAndRack := False;
FiguresList := TracedList;
FiguresList.Clear;
FiguresList.Add(GFigureSnap);
//FSCS_Main.SetFigureAsEndObject(GCadForm, TConnectorObject(BoxFigure));
end
else
if isEndObjectRack and isSnapObjectBox then
begin
//ExistsBoxAndRack := False;
FSCS_Main.SetFigureAsEndObject(GCadForm, TConnectorObject(BoxFigure));
end
else
ExistsBoxAndRack := True;
end;
end;
BeginProgress;
try
GAutoTraceCount := 0;
DoAutoTraceCycle(FiguresList, AID_Cable, ExistsBoxAndRack, aSaveForUndo);
finally
EndProgress;
end;
{IGOR} //D0000006298
if GAutoTraceCount = 0 then
begin
//if GIsProgress then
// PauseProgress(true);
{$IF Defined(SCS_PE)}
if MessageBox(FSCS_Main.Handle, 'Cables were not connected due to lack of free ports' +
#13#10 + 'in Outlets or Boxes or Patch-panels in Telecom Cabinets' +
#13#10 + 'Please add Outlets/Boxes/Patch-panels etc.' +
#13#10 + #13#10 + 'Run cables anyway?', 'Warning', MB_YESNO) = IDYes then
{$ELSE}
if MessageBox(FSCS_Main.Handle, 'Êàáåëü íå áûë ïîäêëþ÷åí, ïî ïðè÷èíå îòñóòñòâèÿ ñâîáîäíûõ ïîðòîâ ' +
#13#10 + 'â ðîçåòêàõ, áîêñàõ èëè ïàò÷-ïàíåëÿõ â øêàôàõ ' +
#13#10 + 'Äîáàâüòå Ðîçåòêè/Áîêñû/Ïàò÷-ïàíåëè' +
#13#10 + #13#10 + 'Àâòîòðàññèðîâàòü ñíîâà?', 'Âíèìàíèå', MB_YESNO) = IDYes then
{$IFEND}
begin
//if GIsProgress then
// PauseProgress(false);
F_AutoTraceConnectOrder.rbTraceManualCable.Checked := True;
if ChoiceAutoTraceConnectOrder(nil, false, ACable, aFromDropConnObj, ptrTrFigInfo) then
begin
BeginProgress;
try
DoAutoTraceCycle(FiguresList, AID_Cable, ExistsBoxAndRack, aSaveForUndo);
finally
EndProgress;
end;
end;
end
//else
// if GIsProgress then
// PauseProgress(false);
end;
//02.07.2013
// // Òðàññèðîâàòü ïî âñåì òî÷êàì
// if not GCadForm.FAutoTraceBySelected then
// begin
// BeginProgress;
// try
// DoAutoTraceCycle(GCadForm.PCad.Figures, AID_Cable);
// finally
// EndProgress;
// end;
// end
// else
// // Òðàññèðîâàòü ïî âûáðàííûì òî÷êàì
// begin
// BeginProgress;
// try
// DoAutoTraceCycle(TracedList, AID_Cable);
// finally
// EndProgress;
// end;
// end;
if TracedList <> nil then
FreeAndNil(TracedList);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.AutoTraceCableFromNB', E.Message);
end;
finally
if (Not WasEndPoint) and (GEndPoint <> nil) then
begin
if GFigureSnap = GEndPoint then
begin
TConnectorObject(GEndPoint).AsEndPoint := False;
GEndPoint := Nil;
GListWithEndPoint := Nil;
RefreshCAD(GCadForm.PCad);
end;
end;
if ptrTrFigInfo <> nil then
FreeMem(ptrTrFigInfo);
end;
end;
procedure DoAutoTraceCycle(AFiguresList: TList; AID_Cable: Integer; aConsiderBoxAndRack: Boolean=false; aSaveForUndo: Boolean=true);
var
i, j: integer;
CanTracingCount: Integer;
CurrentWA: TConnectorObject;
CurrentServer: TConnectorObject;
IsTrace: Boolean;
ObjectsList: TList;
ListOfLists: TIntList;
vLists: TList;
vList: TF_CAD;
TickPrev, TickCurr: Cardinal;
CableToTraceCount: integer;
begin
try
BeginAutoTrace;
TickPrev := GetTickCount;
CurrentServer := nil; //#From Oleg# //14.09.2010
CanTracingCount := 1;
ObjectsList := TList.Create;
ObjectsList := GetSortedListForAutoTrace(aFiguresList);
// ïîëó÷èòü ñïèñîê ëèñòîâ ÷åðåç êîòîðûå áóäåò ïðîâåäåíà àâòîòðàññèðîâêà
ListOfLists := TIntList.create;
if GListWithEndPoint <> nil then
begin
ListOfLists := GetSortedListIDsByBounds(GListWithEndPoint.FCADListID, GCadForm.FCADListID);
end
else
ListOfLists.Add(GCadForm.FCADListID);
if aSaveForUndo then
begin
vLists := TList.Create;
for i := 0 to ListOfLists.Count - 1 do
begin
vList := GetListByID(ListOfLists[i]);
if vList <> nil then
vLists.Add(vList);
end;
SaveForProjectUndo(vLists, True, False);
end;
try
CableToTraceCount := strtoint(F_AutoTraceConnectOrder.neCableTraceCount.Text);
except
CableToTraceCount := 0;
end;
while CanTracingCount > 0 do
begin
CanTracingCount := 0;
for i := 0 to ObjectsList.Count - 1 do
begin
CurrentWA := TConnectorObject(ObjectsList[i]);
if CurrentWA <> nil then
begin
// ***
if CheckFigureByClassName(GEndPoint, cTConnectorObject) then
CurrentServer := TConnectorObject(GEndPoint)
else
if CheckFigureByClassName(GEndPoint, cTHouse) then
CurrentServer := GetEndPointByHouse(THouse(GEndPoint), CurrentWA);
// ***
if CurrentServer <> nil then
begin
{IGOR} //D0000006298
(*
if F_AutoTraceConnectOrder.rbTraceManualCable.Checked then
begin
//Inc(CanTracingCount);
ProcessMessagesEx;
for j := 1 to CableToTraceCount do
begin
GCadForm.FTracingList := GetAllTraceInCAD(CurrentWA, CurrentServer);
if Assigned(GCadForm.FTracingList) then
FreeAndNil(GCadForm.FTracingList);
IsTrace := TracingToEndPoint(CurrentWA, CurrentServer, AID_Cable, false {aConsiderBoxAndRack});
GAutoTraceCount := GAutoTraceCount + 1;
if IsTrace then
begin
GCadForm.mProtocol.Lines.Add(cCommon_Mes2 + CurrentWA.Name + cCommon_Mes3 + CurrentServer.Name + '"');
end
end;
end
else
*)
if F_AutoTraceConnectOrder.rbTraceManualCable.Checked or F_AutoTraceConnectOrder.StreakConnect.Checked then
begin
//Inc(CanTracingCount);
ProcessMessagesEx;
//Tolik
if F_AutoTraceConnectOrder.StreakConnect.Checked and not F_AutoTraceConnectOrder.rbTraceManualCable.Checked then
begin
while CanConnectLineComponWithConObjects(AID_Cable, CurrentWA.ID, CurrentServer.ID, aConsiderBoxAndRack) do
begin
GCadForm.FTracingList := GetAllTraceInCAD(CurrentWA, CurrentServer);
if Assigned(GCadForm.FTracingList) then
FreeAndNil(GCadForm.FTracingList);
IsTrace := TracingToEndPoint(CurrentWA, CurrentServer, AID_Cable, false {aConsiderBoxAndRack});
GAutoTraceCount := GAutoTraceCount + 1;
if IsTrace then
begin
GCadForm.mProtocol.Lines.Add(cCommon_Mes2 + CurrentWA.Name + cCommon_Mes3 + CurrentServer.Name + '"');
end
else
break;
end;
end
else
begin
for j := 1 to CableToTraceCount do
begin
GCadForm.FTracingList := GetAllTraceInCAD(CurrentWA, CurrentServer);
if Assigned(GCadForm.FTracingList) then
FreeAndNil(GCadForm.FTracingList);
IsTrace := TracingToEndPoint(CurrentWA, CurrentServer, AID_Cable, false {aConsiderBoxAndRack});
GAutoTraceCount := GAutoTraceCount + 1;
if IsTrace then
begin
GCadForm.mProtocol.Lines.Add(cCommon_Mes2 + CurrentWA.Name + cCommon_Mes3 + CurrentServer.Name + '"');
end
end;
end;
end
else
begin
if CanConnectLineComponWithConObjects(AID_Cable, CurrentWA.ID, CurrentServer.ID, aConsiderBoxAndRack) then
begin
Inc(CanTracingCount);
ProcessMessagesEx;
IsTrace := TracingToEndPoint(CurrentWA, CurrentServer, AID_Cable, aConsiderBoxAndRack);
if IsTrace then
begin
GAutoTraceCount := GAutoTraceCount + 1;
GCadForm.mProtocol.Lines.Add(cCommon_Mes2 + CurrentWA.Name + cCommon_Mes3 + CurrentServer.Name + '"');
end
else
// â ïðîòîêîë
begin
Dec(CanTracingCount);
GCadForm.mProtocol.Lines.Add(cCommon_Mes4 + CurrentWA.Name + cCommon_Mes5 + #13#10 + cCommon_Mes6);
end;
end
else
begin
GCadForm.mProtocol.Lines.Add(cCommon_Mes4 + CurrentWA.Name + cCommon_Mes5 + #13#10 + cCommon_Mes6);
end;
end;
end;
end;
end;
end;
FreeAndNil(ObjectsList);
//Tolik
FreeAndNil(ListOfLists);
FreeAndNil(vLists);
//
except
on E: Exception do addExceptionToLogEx('U_Common.DoAutoTraceCycle', E.Message);
end;
TickCurr := GetTickCount - TickPrev;
TickCurr := GetTickCount - TickPrev;
EndAutoTrace;
end;
Procedure AutoConnectBetweenFloorPassage(ACable: TOrthoLine; ASide: Integer; ARaise: TConnectorObject);
var
i, j: integer;
JoinedConn1, JoinedConn2: TConnectorObject;
JoinedObject: TConnectorObject;
JoinedLine: TOrthoLine;
isConnected: Boolean;
ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam;
ParamsList1, ParamsList2: TList;
ListOfPassage: TF_CAD;
ConnOfPassage: TConnectorObject;
begin
try
ParamsList1 := TList.Create;
ParamsList2 := TList.Create;
// èíòåðôåéñû êàáåëÿ
New(ptrInterfRecord1);
ptrInterfRecord1.IDObject := ACable.ID;
if ASide = 1 then
ptrInterfRecord1.Side := 1;
if ASide = 2 then
ptrInterfRecord1.Side := 2;
ParamsList1.Add(ptrInterfRecord1);
// ïîëó÷èòü îáúåêò è ëèñò ïåðåõîäà
ListOfPassage := GetListOfPassage(ARaise.FID_ListToPassage);
if ListOfPassage <> nil then
begin
ConnOfPassage := TConnectorObject(GetFigureByID(ListOfPassage, ARaise.FID_ConnToPassage));
for j := 0 to ConnOfPassage.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(ConnOfPassage.JoinedOrtholinesList[j]);
if JoinedLine.FIsRaiseUpDown then
begin
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := JoinedLine.ID;
if ConnOfPassage = JoinedLine.JoinConnector1 then
ptrInterfRecord2.Side := 1;
if ConnOfPassage = JoinedLine.JoinConnector2 then
ptrInterfRecord2.Side := 2;
ParamsList2.Add(ptrInterfRecord2);
end;
end;
end;
isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2);
// if ParamsList1 <> nil then
// FreeAndNil(ParamsList1);
// if ParamsList2 <> nil then
// FreeAndNil(ParamsList2);
except
on E: Exception do addExceptionToLogEx('U_Common.AutoConnectBetweenFloorPassage', E.Message);
end;
end;
Function GetBetweenFloorRaiseLine(ALine: TOrthoLine): TOrthoLine;
var
AConnRaiseType: TConnRaiseType;
i: integer;
RaiseConn: TConnectorObject;
RaiseConnPassage: TConnectorObject;
ListOfPassage: TF_CAD;
ConnOfPassage: TConnectorObject;
begin
Result := nil;
try
AConnRaiseType := TConnectorObject(ALine.JoinConnector1).FConnRaiseType;
if (AConnRaiseType = crt_BetweenFloorUp) or (AConnRaiseType = crt_BetweenFloorDown) then
begin
RaiseConn := TConnectorObject(ALine.JoinConnector1);
ListOfPassage := GetListOfPassage(RaiseConn.FID_ListToPassage);
if ListOfPassage <> nil then
begin
RaiseConnPassage := TConnectorObject(GetFigureByID(ListOfPassage, RaiseConn.FID_ConnToPassage));
for i := 0 to RaiseConnPassage.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(RaiseConnPassage.JoinedOrtholinesList[i]).FIsRaiseUpDown then
Result := TOrthoLine(RaiseConnPassage.JoinedOrtholinesList[i]);
end;
end;
AConnRaiseType := TConnectorObject(ALine.JoinConnector2).FConnRaiseType;
if (AConnRaiseType = crt_BetweenFloorUp) or (AConnRaiseType = crt_BetweenFloorDown) then
begin
RaiseConn := TConnectorObject(ALine.JoinConnector2);
ListOfPassage := GetListOfPassage(RaiseConn.FID_ListToPassage);
if ListOfPassage <> nil then
begin
RaiseConnPassage := TConnectorObject(GetFigureByID(ListOfPassage, RaiseConn.FID_ConnToPassage));
for i := 0 to RaiseConnPassage.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(RaiseConnPassage.JoinedOrtholinesList[i]).FIsRaiseUpDown then
Result := TOrthoLine(RaiseConnPassage.JoinedOrtholinesList[i]);
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetBetweenFloorRaiseLine', E.Message);
end;
end;
Function TracingToEndPoint(ACurrentWS, AEndPoint: TConnectorObject; AID_Cable: Integer; aConsiderBoxAndRack: Boolean=false): Boolean;
var
i, j: integer;
RaiserThisList: TConnectorObject;
RaiserOtherList: TConnectorObject;
CurGCadForm: TF_CAD;
ComponID: Integer;
isConnected: Boolean;
IDLine: Integer;
IDPointer: ^Integer;
AllTrace: TList;
AllTraceItList: TList;
AllTraceOtherList: TList;
AllSCSObjs: TList;
SetLinesList: TIntList;
SCSObj: TSCSCatalog;
ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam;
ParamsList1, ParamsList2: TList;
CurrLine: TOrthoLine;
CurrConn: TConnectorObject;
RaiseType: TConnRaiseType;
ListOfLists: TIntList;
ListOfRaises: TList;
CurrentCAD: TF_CAD;
ConnFrom: TConnectorObject;
ConnTo: TConnectorObject;
PrevConn: TConnectorObject;
PrevCAD: TF_CAD;
begin
Result := False;
try
if (ACurrentWS = nil) or (AEndPoint = nil) then
exit;
ProcessMessagesEx;
if GListWithEndPoint = GCadForm then
begin
// åñëè
if not CheckTrunkObject(AEndPoint) or not CheckTrunkObject(AEndPoint) then
begin
// *** Ïîëó÷èòü òåêóùèé ïóòü ïîñëå âûäåëåíèÿ
// *** åãî íå áóäåò åñëè íå áûëî ðó÷íîãî âûäåëåíèÿ ïóòè
if GCadForm.FTracingList = nil then
AllTrace := GetAllTraceInCAD(AEndPoint, ACurrentWS)
else
AllTrace := GCadForm.FTracingList;
// âûäåëèòü òðàññó
if AllTrace <> nil then
begin
AllSCSObjs := TList.Create;
for i := 0 to AllTrace.Count - 1 do
TFigure(AllTrace[i]).Select;
DisableMarking; //15.01.2011 - Îòêëþ÷àåì ãåíåðàöèþ ìàðêèðîâêè äëÿ êàáåëÿ
try
// ñêîïèðîâàòü êàáåëü òóäà
for i := 0 to AllTrace.Count - 1 do
begin
//08.11.2011 ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AID_Cable);
ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AID_Cable, false, @SCSObj);
AllSCSObjs.Add(SCSObj);
end;
finally
EnableMarking;
end;
// óáðàòü âûäåëåíèå òðàññû
for i := 0 to AllTrace.Count - 1 do
TFigure(AllTrace[i]).DeSelect;
//
SetLinesList := TIntList.Create;
for i := 0 to AllTrace.Count - 1 do
begin
IDLine := TFigure(AllTrace[i]).ID;
SetLinesList.Add(IDLine);
end;
isConnected := ConnectObjectsInPMByWay(SetLinesList, AllTrace, AllSCSObjs, nil, aConsiderBoxAndRack); //08.11.2011 isConnected := ConnectObjectsInPMByWay(SetLinesList, AllSCSObjs);
if SetLinesList <> nil then
FreeAndNil(SetLinesList);
if AllTrace <> nil then
FreeAndNil(AllTrace);
if GCadForm.FTracingList <> nil then
GCadForm.FTracingList := nil;
Result := True;
//if aConsiderBoxAndRack then
// if Not isConnected then
// Result := false;
AllSCSObjs.Free;
end;
GCadForm.FTracingListIndex := 0;
end
else
begin
TracingTrunkToEndPoint(ACurrentWS, AEndPoint, AID_Cable);
end;
end
else
if GListWithEndPoint <> nil then
begin
RaiseType := crt_BetweenFloorDown; //#From Oleg# //14.09.2010
// äðóãîé ëèñò ñ ÊÎ
if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GListWithEndPoint.FCADListID then
RaiseType := crt_BetweenFloorDown;
if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GCadForm.FCADListID then
RaiseType := crt_BetweenFloorUp;
ListOfLists := GetSortedListIDsByBounds(GListWithEndPoint.FCADListID, GCadForm.FCADListID);
if ListOfLists.Count >= 2 then
begin
ListOfRaises := GetSortedListOfRaises(ListOfLists, RaiseType, AEndPoint, ACurrentWS);
if ListOfLists.Count >= 2 then
begin
if CheckCanTracingBetweenFloor(ListOfLists, ListOfRaises) then
begin
PrevCAD := nil;
PrevConn := nil;
SetLinesList := TIntList.Create;
DisableMarking; //15.01.2011 - Îòêëþ÷àåì ãåíåðàöèþ ìàðêèðîâêè äëÿ êàáåëÿ
try
// CICLE
for i := 0 to ListOfLists.Count - 1 do
begin
CurrentCAD := GetListByID(ListOfLists[i]);
if i < ListOfLists.Count - 1 then
ConnTo := TConnectorObject(ListOfRaises[i])
else
ConnTo := ACurrentWS;
CurGCadForm := GCadForm;
GCadForm := CurrentCAD;
if i = 0 then
begin
ConnFrom := AEndPoint;
end
else
begin
ConnFrom := TConnectorObject(GetFigureByID(GCadForm, PrevConn.FID_ConnToPassage));
end;
if GCadForm.FTracingList = nil then
AllTrace := GetAllTraceInCAD(ConnFrom, ConnTo)
else
AllTrace := GCadForm.FTracingList;
if AllTrace <> nil then
begin
for j := 0 to AllTrace.Count - 1 do
TFigure(AllTrace[j]).Select;
for j := 0 to AllTrace.Count - 1 do
ComponID := CopyComponentToSCSObject(TFigure(AllTrace[j]).ID, AID_Cable);
for j := 0 to AllTrace.Count - 1 do
TFigure(AllTrace[j]).DeSelect;
RefreshCAD(GCadForm.PCad);
for j := 0 to AllTrace.Count - 1 do
begin
IDLine := TOrthoLine(AllTrace[j]).ID;
SetLinesList.Add(IDLine);
end;
end;
if AllTrace <> nil then
FreeAndNil(AllTrace);
if GCadForm.FTracingList <> nil then
GCadForm.FTracingList := nil;
GCadForm.FTracingListIndex := 0;
GCadForm := CurGCadForm;
PrevCAD := CurrentCAD;
PrevConn := ConnTo;
end;
finally
EnableMarking;
end;
isConnected := ConnectObjectsInPMByWay(SetLinesList, nil, nil, nil);
if SetLinesList <> nil then
FreeAndNil(SetLinesList);
Result := True;
end;
end;
end;
if ListOfLists <> nil then
FreeAndNil(ListOfLists);
if ListOfRaises <> nil then
FreeAndNil(ListOfRaises);
end;
if ACurrentWS <> nil then
if ACurrentWS.ConnectorType = ct_Clear then
begin
if ACurrentWS.JoinedOrtholinesList.Count > 1 then
begin
ParamsList1 := TList.Create;
ParamsList2 := TList.Create;
// èíòåðôåéñû êàáåëÿ
CurrLine := TOrthoLine(ACurrentWS.JoinedOrtholinesList[0]);
New(ptrInterfRecord1);
ptrInterfRecord1.IDObject := CurrLine.ID;
if CurrLine.JoinConnector1 = ACurrentWS then
ptrInterfRecord1.Side := 1;
if CurrLine.JoinConnector2 = ACurrentWS then
ptrInterfRecord1.Side := 2;
ParamsList1.Add(ptrInterfRecord1);
for i := 1 to ACurrentWS.JoinedOrtholinesList.Count - 1 do
begin
CurrLine := TOrthoLine(ACurrentWS.JoinedOrtholinesList[i]);
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := CurrLine.ID;
if CurrLine.JoinConnector1 = ACurrentWS then
ptrInterfRecord2.Side := 1;
if CurrLine.JoinConnector2 = ACurrentWS then
ptrInterfRecord2.Side := 2;
ParamsList2.Add(ptrInterfRecord2);
end;
isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2);
FreeAndNil(ParamsList1);
FreeAndNil(ParamsList2);
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.TracingToEndPoint', E.Message);
end;
end;
Procedure ApplyParamsForAllSCSObject(AConnHeight, ALineHeight: Double; AConnCaptionsShowType, AConnNotesShowType: TShowType; ALineCaptionsShowType, ALineNotesShowType: TShowKind; aCADParams: TCADParams);
var
i, k: integer;
CurrObject: TConnectorObject;
CurrTrace: TOrthoLine;
ObjParams: TObjectParams;
TracesList: TList;
NotesList: TStringList;
x1, y1, z1, x2, y2, z2: double;
GetPointObject: TConnectorObject;
LinesList: TList;
ConnsList: TList;
valBool: Boolean;
valInteger: Integer;
valDouble: Double;
valString: string;
valColor: TColor;
Str: string;
isApply: Boolean;
PairCount: Integer;
PairStr: string;
NotesCaptions: TRichTextMod;
Captions: TRichTextMod;
CadCrossObject: TCadCrossObject;
valPrintType: TPrintType;
CurrRichText: TRichTextMod;
begin
try
BeginProgress;
valPrintType := pt_Color;
TracesList := TList.Create;
LinesList := TList.Create;
ConnsList := TList.Create;
// çàíåñåíèå â ëèñòû
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then
begin
CurrTrace := TOrthoLine(GCadForm.PCad.Figures[i]);
if not CurrTrace.FIsRaiseUpDown then
if CurrTrace.ActualZOrder[1] = CurrTrace.ActualZOrder[2] then
TracesList.Add(CurrTrace);
LinesList.Add(CurrTrace);
end
else if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then
begin
CurrObject := TConnectorObject(GCadForm.PCad.Figures[i]);
ConnsList.Add(CurrObject);
end;
end;
// ÈÇÌÅÍÅÍÈÅ ÐÀÑÏÎËÎÆÅÍÈß ÎÁÚÅÊÒÎÂ
// ïîèñê âñåõ îáúåêòîâ
for i := 0 to ConnsList.Count - 1 do
begin
CurrObject := TConnectorObject(ConnsList[i]);
// Selected
if not F_MasterNewList.cbApplyForSelectedOnly.Checked then
isApply := True
else
begin
if CurrObject.Selected then
isApply := True
else
isApply := False;
end;
//
if isApply then
begin
if CurrObject.ConnectorType <> ct_Clear then
begin
if not HaveObjectCorkComponent(CurrObject.ID) then
begin
valDouble := UOMToMetre(StrToFloat_My(F_MasterNewList.edConnTotal.Text));
if aCADParams.CADHeightConns <> valDouble then
begin
if CurrObject.ActualZOrder[1] <> AConnHeight then
ApplyParamsForObjects(CurrObject, AConnHeight);
end;
end;
// Captions
valBool := F_MasterNewList.cbShowConnectorsCaptions.Checked;
if ((TCheckBoxState(F_MasterNewList.cbShowConnectorsCaptions.State) <> cbGrayed) and (aCADParams.CADShowConnObjectCaption <> valBool)) or
(aCADParams.CADObjectCaptions <> AConnCaptionsShowType) then
begin
ObjParams := GetFigureParams(CurrObject.ID);
CurrObject.Name := ObjParams.Name;
CurrObject.FIndex := ObjParams.MarkID;
SetConnNameInCaptionOnCAD(CurrObject);
end;
{====================================================================}
// âûíîñêè
valBool := F_MasterNewList.cbShowConnectorsNotes.Checked;
if ((TCheckBoxState(F_MasterNewList.cbShowConnectorsNotes.State) <> cbGrayed) and (aCADParams.CADShowConnObjectNote <> valBool)) or
((aCADParams.CADObjectNotes <> AConnNotesShowType) or (aCADParams.CADLinesNotes <> ALineNotesShowType)) then
begin
NotesList := GetObjectNotesWithParams(CurrObject.ID);
SetConnNotesInCAD(GCadForm.FCADListID, CurrObject.ID, NotesList);
if NotesList <> nil then
FreeAndNil(NotesList);
end;
{====================================================================}
// öâåò ïîäïèñè ê ÒÎ
valColor := F_MasterNewList.cbConnectorsCaptionsColor.ColorValue;
if aCADParams.CADConnectorsCaptionsColor <> valColor then
begin
CurrObject.FCaptionsFontColor := valColor;
CurrObject.ReCreateCaptionsGroup(True, True);
end;
// öâåò âûíîñêè ê ÒÎ
valColor := F_MasterNewList.cbConnectorsNotesColor.ColorValue;
if aCADParams.CADConnectorsNotesColor <> valColor then
begin
CurrObject.FNotesFontColor := valColor;
CurrObject.ReCreateNotesGroup(True);
end;
// ðàçìåð øðèôòà ïîäïèñè ê ÒÎ
valInteger := StrToInt(F_MasterNewList.cbConnectorsCaptionsFontSize.Text);
valString := F_MasterNewList.cbFontName.FontName;
if (aCADParams.CADConnectorsCaptionsFontSize <> valInteger) then
begin
if CurrObject.FCaptionsFontSize <> valInteger then
begin
CurrObject.FCaptionsFontSize := valInteger;
CurrObject.ReCreateCaptionsGroup(True, True);
end;
end
else
if (aCADParams.CADFontName <> valString) then
begin
if CurrObject.FCaptionsFontName <> valString then
begin
CurrObject.FCaptionsFontName := valString;
CurrObject.ReCreateCaptionsGroup(True, True);
end;
end;
// ðàçìåð øðèôòà âûíîñêè ê ÒÎ
valInteger := StrToInt(F_MasterNewList.cbConnectorsNotesFontSize.Text);
valString := F_MasterNewList.cbFontName.FontName;
if (aCADParams.CADConnectorsNotesFontSize <> valInteger) then
begin
if CurrObject.FNotesFontSize <> valInteger then
begin
CurrObject.FNotesFontSize := valInteger;
CurrObject.ReCreateNotesGroup(True);
end;
end
else
if (aCADParams.CADFontName <> valString) then
begin
if CurrObject.FNotesFontName <> valString then
begin
CurrObject.FNotesFontName := valString;
CurrObject.ReCreateNotesGroup(True);
end;
end;
// îòîáðàæåíèå ïå÷àòè ÷åðíî-áåëàÿ/öâåòíàÿ
if F_MasterNewList.cbBlackPrint.Checked then
valPrintType := pt_Black;
if F_MasterNewList.cbColorPrint.Checked then
valPrintType := pt_Color;
// ðàçìåð è ñòèëü øðèôòà äëÿ Êðîññ ÀÒÑ
if CurrObject.FTrunkName = ctsnCrossATS then
begin
valInteger := StrToInt(F_MasterNewList.cbCrossATSFontSize.Text);
valBool := F_MasterNewList.cbCrossATSFontBold.Checked;
if (aCADParams.CADCrossATSFontSize <> valInteger) or (aCADParams.CADCrossATSFontBold <> valBool) or (aCADParams.CADPrintType <> valPrintType) then
begin
CadCrossObject := GetPointObjectConnectedTrunk(GCadForm.FCADListID, CurrObject.ID);
ChangeCrossATSInterf(GCadForm.FCADListID, CurrObject.ID, CadCrossObject);
end;
end;
// ðàçìåð øðèôòà äëÿ ÐØ
if CurrObject.FTrunkName = ctsnDistributionCabinet then
begin
valInteger := StrToInt(F_MasterNewList.cbDistribCabFontSize.Text);
valBool := F_MasterNewList.cbDistribCabFontBold.Checked;
if (aCADParams.CADDistribCabFontSize <> valInteger) or (aCADParams.CADDistribCabFontBold <> valBool) or (aCADParams.CADPrintType <> valPrintType) then
begin
CadCrossObject := GetPointObjectConnectedTrunk(GCadForm.FCADListID, CurrObject.ID);
ChangeDistribCabInterf(GCadForm.FCADListID, CurrObject.ID, CadCrossObject);
end;
end;
end;
end;
end;
for i := 0 to LinesList.Count - 1 do
begin
CurrTrace := TOrthoLine(LinesList[i]);
// Selected
if not F_MasterNewList.cbApplyForSelectedOnly.Checked then
isApply := True
else
begin
if CurrTrace.Selected then
isApply := True
else
isApply := False;
end;
//
if isApply then
begin
valDouble := UOMToMetre(StrToFloat_My(F_MasterNewList.edLineTotal.Text));
if aCADParams.CADHeightLines <> valDouble then
begin
if not CurrTrace.FIsRaiseUpDown then
if (CurrTrace.ActualZOrder[1] <> ALineHeight) or (CurrTrace.ActualZOrder[2] <> ALineHeight) then
begin
ApplyParamsForTraces(CurrTrace, ALineHeight, TracesList);
CurrTrace.CalculLength := CurrTrace.LengthCalc;
CurrTrace.LineLength := CurrTrace.CalculLength;
CurrTrace.UpdateLengthTextBox(False, True);
end;
end;
// ïîäïèñü ê òðàññå
valBool := F_MasterNewList.cbShowLinesCaptions.Checked;
if ((TCheckBoxState(F_MasterNewList.cbShowLinesCaptions.State) <> cbGrayed) and (aCADParams.CADShowLineObjectCaption <> valBool)) or
(aCADParams.CADLinesCaptions <> ALineCaptionsShowType) then
begin
// âêèíóòü êîë-âî ïàð â OutTextCaptions[1] èëè óáðàòü îòòóäà
ReverseCaptionAfterTypeChange(CurrTrace, aCADParams.CADLinesCaptions, ALineCaptionsShowType);
CurrTrace.UpdateLengthTextBox(True, True);
end;
{========================================================================}
// âûíîñêà ê òðàññå
valBool := F_MasterNewList.cbShowLinesNotes.Checked;
// WARNING !!!
if ((TCheckBoxState(F_MasterNewList.cbShowLinesNotes.State) <> cbGrayed) and (aCADParams.CADShowLineObjectNote <> valBool)) or
((aCADParams.CADObjectNotes <> AConnNotesShowType) or (aCADParams.CADLinesNotes <> ALineNotesShowType)) then
begin
NotesList := GetObjectNotesWithParams(CurrTrace.ID);
SetLineNotesInCAD(GCadForm.FCADListID, CurrTrace.ID, NotesList);
if NotesList <> nil then
FreeAndNil(NotesList);
end;
{========================================================================}
if not CurrTrace.FIsRaiseUpDown then
begin
// öâåò òðàññû
valColor := F_MasterNewList.cbTraceColor.ColorValue;
if aCADParams.CADTraceColor <> valColor then
CurrTrace.FTraceColor := F_MasterNewList.cbTraceColor.ColorValue;
// ñòèëü òðàññû
valInteger := F_MasterNewList.cbTraceStyle.ItemIndex;
if ord(aCADParams.CADTraceStyle) <> valInteger then
CurrTrace.FTraceStyle := TPenStyle(F_MasterNewList.cbTraceStyle.ItemIndex);
// øèðèíà òðàññû
valInteger := StrToInt(F_MasterNewList.edTraceWidth.Text);
if aCADParams.CADTraceWidth <> valInteger then
CurrTrace.FTraceWidth := StrToInt(F_MasterNewList.edTraceWidth.Text);
// øàã óñë. îáîçíà÷åíèÿ
valDouble := StrToFloat_My(F_MasterNewList.edBlockStep.Text);
if aCADParams.CADBlockStep <> valDouble then
begin
if CurrTrace.BlockStep <> StrToFloat_My(F_MasterNewList.edBlockStep.Text) then
begin
CurrTrace.BlockStep := StrToFloat_My(F_MasterNewList.edBlockStep.Text);
CurrTrace.ReCreateDrawFigureBlock;
end;
end;
end;
// öâåò ïîäïèñè ê òðàññå
valColor := F_MasterNewList.cbLinesCaptionsColor.ColorValue;
if aCADParams.CADLinesCaptionsColor <> valColor then
begin
CurrTrace.FCaptionsFontColor := valColor;
CurrTrace.ReCreateCaptionsGroup(True, True);
end;
// öâåò âûíîñêè ê òðàññå
valColor := F_MasterNewList.cbLinesNotesColor.ColorValue;
if aCADParams.CADLinesNotesColor <> valColor then
begin
CurrTrace.FNotesFontColor := valColor;
CurrTrace.ReCreateNotesGroup(True);
end;
// ðàçìåð øðèôòà ïîäïèñè ê òðàññå
valInteger := StrToInt(F_MasterNewList.cbLinesCaptionsFontSize.Text);
valBool := F_MasterNewList.cbLinesCaptionsFontBold.Checked;
valString := F_MasterNewList.cbFontName.FontName;
if (aCADParams.CADLinesCaptionsFontSize <> valInteger) or (aCADParams.CADLinesCaptionsFontBold <> valBool) then
begin
if (CurrTrace.FCaptionsFontSize <> valInteger) or (CurrTrace.FCaptionsFontBold <> valBool) then
begin
CurrTrace.FCaptionsFontSize := valInteger;
CurrTrace.FCaptionsFontBold := valBool;
CurrTrace.ReCreateCaptionsGroup(True, True);
end;
end
else
if (aCADParams.CADFontName <> valString) then
begin
if CurrTrace.FCaptionsFontName <> valString then
begin
CurrTrace.FCaptionsFontName := valString;
CurrTrace.ReCreateCaptionsGroup(True, True);
end;
end;
// ðàçìåð øðèôòà âûíîñêè ê òðàññå
valInteger := StrToInt(F_MasterNewList.cbLinesNotesFontSize.Text);
valString := F_MasterNewList.cbFontName.FontName;
if (aCADParams.CADLinesNotesFontSize <> valInteger) then
begin
if CurrTrace.FNotesFontSize <> valInteger then
begin
CurrTrace.FNotesFontSize := valInteger;
CurrTrace.ReCreateNotesGroup(True);
end;
end
else
if (aCADParams.CADFontName <> valString) then
begin
if CurrTrace.FNotesFontName <> valString then
begin
CurrTrace.FNotesFontName := valString;
CurrTrace.ReCreateNotesGroup(True);
end;
end;
end;
end;
{**************************************************************************}
if TracesList <> nil then
FreeAndNil(TracesList);
if LinesList <> nil then
FreeAndNil(LinesList);
if ConnsList <> nil then
FreeAndNil(ConnsList);
// ñîçäàíèå ëèñòà
if F_MasterNewList.Tag = 0 then
SaveMaskTemplatesFromForm(F_MasterNewList.F_ComponTypesMarkMask, GCadForm.FCADListID, itList, True, True)
// ðåäàêòèðîâàíèå ëèñòà
else
SaveMaskTemplatesFromForm(F_MasterNewList.F_ComponTypesMarkMask, GCadForm.FCADListID, itList, True, False);
RefreshCAD(GCadForm.PCad);
// SP !!!
CheckDeleteAllRaises(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.ApplyParamsForAllSCSObject', E.Message);
end;
EndProgress;
end;
Procedure ApplyParamsForObjects(AObject: TConnectorObject; AHeight: Double);
begin
BaseBeginUpdate;
try
// íåò ñ-ï
if GetRaiseConn(AObject) = nil then
begin
if AObject.JoinedConnectorsList.Count = 0 then
begin
AObject.ActualZOrder[1] := AHeight;
SetConFigureCoordZInPM(AObject.ID, AHeight);
end
else
CreateRaiseOnPointObject(AObject, AHeight);
end
// åñòü ñ-ï
else
// ñäâèíóòü íà âûñîòó
begin
// òîëüêî ïîäúåì-ñïóñê
if AObject.JoinedConnectorsList.Count = 0 then
begin
AObject.ActualZOrder[1] := AHeight;
SetConFigureCoordZInPM(AObject.ID, AHeight);
end
else
ChangeRaiseOnPointObject(AObject, AHeight);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ApplyParamsForObjects', E.Message);
end;
BaseEndUpdate;
end;
Procedure ApplyParamsForTraces(ATrace: TOrthoLine; AHeight: Double; ATracesList: TList);
begin
BaseBeginUpdate;
try
RaiseLineOnHeight(ATrace, AHeight, ATracesList);
except
on E: Exception do addExceptionToLogEx('U_Common.ApplyParamsForTraces', E.Message);
end;
BaseEndUpdate;
end;
Procedure ApplyCornerTypeForConnectors(aCornerType: TCornerType);
var
i: integer;
FConnector: TConnectorObject;
isApply: Boolean;
begin
try
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then
begin
FConnector := TConnectorObject(GCadForm.PCad.Figures[i]);
// Selected
if not F_MasterNewList.cbApplyForSelectedOnly.Checked then
isApply := True
else
begin
if FConnector.Selected then
isApply := True
else
isApply := False;
end;
//
if isApply then
begin
if CheckCornerTypeMaybeChanged(FConnector, aCornerType) then
FConnector.FCornerType := aCornerType;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ApplyCornerTypeForConnectors', E.Message);
end;
end;
Function CheckCornertypeMaybeChanged(aConnector: TConnectorObject; aCornerType: TCornerType): Boolean;
var
i, j: Integer;
JoinedConn1: TConnectorObject;
JoinedConn2: TConnectorObject;
JoinedLine1: TOrthoLine;
JoinedLine2: TOrthoLine;
Angle: Double;
begin
Result := False;
try
// ÍÅÒ
if aCornerType = crn_None then
begin
{
if aConnector.ConnectorType = ct_Clear then
begin
if (aConnector.JoinedOrtholinesList.Count = 0) and (aConnector.JoinedOrtholinesList.Count = 1) or (aConnector.JoinedOrtholinesList.Count = 3) then
Result := True;
end
else
begin
if (aConnector.JoinedConnectorsList.Count = 0) or (aConnector.JoinedConnectorsList.Count = 1) or (aConnector.JoinedConnectorsList.Count = 3) then
Result := True;
end;
}
Result := True;
end;
// ÂÍÅØÍÈÉ èëè ÂÍÓÒÐÅÍÍÈÉ
if (aCornerType = crn_Out) or (aCornerType = crn_In) then
begin
if (aConnector.FConnRaiseType = crt_None) and (GetRaiseConn(aConnector) = nil) then
begin
if aConnector.ConnectorType = ct_Clear then
begin
if aConnector.JoinedOrtholinesList.Count = 2 then
begin
JoinedLine1 := TOrthoLine(aConnector.JoinedOrtholinesList[0]);
JoinedLine2 := TOrthoLine(aConnector.JoinedOrtholinesList[1]);
if not JoinedLine1.FIsRaiseUpDown and not JoinedLine2.FIsRaiseUpDown then
begin
Angle := CalcAngleBetweenLines(JoinedLine1, JoinedLine2, aConnector);
if (Angle <> 0) and (Angle <> 180) and (Angle <> 360) then
Result := True;
end;
end;
end
else
begin
if aConnector.JoinedConnectorsList.Count = 2 then
begin
JoinedConn1 := TConnectorObject(aConnector.JoinedConnectorsList[0]);
JoinedConn2 := TConnectorObject(aConnector.JoinedConnectorsList[1]);
if (JoinedConn1.JoinedOrtholinesList.Count = 1) and (JoinedConn2.JoinedOrtholinesList.Count = 1) then
begin
JoinedLine1 := TOrthoLine(JoinedConn1.JoinedOrtholinesList[0]);
JoinedLine2 := TOrthoLine(JoinedConn2.JoinedOrtholinesList[0]);
if not JoinedLine1.FIsRaiseUpDown and not JoinedLine2.FIsRaiseUpDown then
begin
Angle := CalcAngleBetweenLines(JoinedLine1, JoinedLine2, aConnector);
if (Angle <> 0) and (Angle <> 180) and (Angle <> 360) then
Result := True;
end;
end;
end;
end;
end;
end;
// ÏËÎÑÊÈÉ
if aCornerType = crn_Vertical then
begin
if (aConnector.FConnRaiseType <> crt_None) or (GetRaiseConn(aConnector) <> nil) then
begin
if aConnector.ConnectorType = ct_Clear then
begin
if aConnector.JoinedOrtholinesList.Count = 2 then
begin
JoinedLine1 := TOrthoLine(aConnector.JoinedOrtholinesList[0]);
JoinedLine2 := TOrthoLine(aConnector.JoinedOrtholinesList[1]);
if JoinedLine1.FIsRaiseUpDown or JoinedLine2.FIsRaiseUpDown then
begin
Result := True;
end;
end;
end
else
begin
if aConnector.JoinedConnectorsList.Count = 2 then
begin
JoinedConn1 := TConnectorObject(aConnector.JoinedConnectorsList[0]);
JoinedConn2 := TConnectorObject(aConnector.JoinedConnectorsList[1]);
if (JoinedConn1.JoinedOrtholinesList.Count = 1) and (JoinedConn2.JoinedOrtholinesList.Count = 1) then
begin
JoinedLine1 := TOrthoLine(JoinedConn1.JoinedOrtholinesList[0]);
JoinedLine2 := TOrthoLine(JoinedConn2.JoinedOrtholinesList[0]);
if JoinedLine1.FIsRaiseUpDown or JoinedLine2.FIsRaiseUpDown then
begin
Result := True;
end;
end;
end;
end;
end;
end;
// ÀÄÀÏÒÅÐ
if aCornerType = crn_Adapter then
begin
if (aConnector.FConnRaiseType = crt_None) and (GetRaiseConn(aConnector) = nil) then
begin
if aConnector.ConnectorType = ct_Clear then
begin
if aConnector.JoinedOrtholinesList.Count = 2 then
begin
JoinedLine1 := TOrthoLine(aConnector.JoinedOrtholinesList[0]);
JoinedLine2 := TOrthoLine(aConnector.JoinedOrtholinesList[1]);
if not JoinedLine1.FIsRaiseUpDown and not JoinedLine2.FIsRaiseUpDown then
begin
Angle := CalcAngleBetweenLines(JoinedLine1, JoinedLine2, aConnector);
if Angle = 180 then
Result := True;
end;
end;
end
else
begin
if aConnector.JoinedConnectorsList.Count = 2 then
begin
JoinedConn1 := TConnectorObject(aConnector.JoinedConnectorsList[0]);
JoinedConn2 := TConnectorObject(aConnector.JoinedConnectorsList[1]);
if (JoinedConn1.JoinedOrtholinesList.Count = 1) and (JoinedConn2.JoinedOrtholinesList.Count = 1) then
begin
JoinedLine1 := TOrthoLine(JoinedConn1.JoinedOrtholinesList[0]);
JoinedLine2 := TOrthoLine(JoinedConn2.JoinedOrtholinesList[0]);
if not JoinedLine1.FIsRaiseUpDown and not JoinedLine2.FIsRaiseUpDown then
begin
Angle := CalcAngleBetweenLines(JoinedLine1, JoinedLine2, aConnector);
if Angle = 180 then
Result := True;
end;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckCornertypeMaybeChanged', E.Message);
end;
end;
function GetAngleBetweenLines(AListID, AIDLine1, AIDLine2, AIDConnector: Integer; aAngleType: TAngleType): Double;
var
vList: TF_CAD;
vLine1, vLine2: TOrthoLine;
vConn: TConnectorObject;
begin
Result := 0;
try
vList := GetListByID(AListID);
if vList <> nil then
begin
vLine1 := TOrthoLine(GetFigureByID(vList, AIDLine1));
vLine2 := TOrthoLine(GetFigureByID(vList, AIDLine2));
vConn := TConnectorObject(GetFigureByID(vList, AIDConnector));
if (vLine1 <> nil) and (vLine2 <> nil) and (vConn <> nil) then
Result := CalcAngleBetweenLines(vLine1, vLine2, vConn);
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.GetAngleBetweenLines', E.Message);
end;
end;
Function CalcAngleBetweenLines(aLine1, aLine2: TOrthoLine; aConnector: TConnectorObject): Double;
var
i, j: integer;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
Angle1, Angle2: Double;
begin
Result := 0;
try
Angle1 := 0;
Angle2 := 0;
if aConnector.ConnectorType = ct_Clear then
begin
if aLine1.JoinConnector1 = aConnector then
Angle1 := GetLineAngle(aLine1.ActualPoints[1], aLine1.ActualPoints[2]);
if aLine1.JoinConnector2 = aConnector then
Angle1 := GetLineAngle(aLine1.ActualPoints[2], aLine1.ActualPoints[1]);
if aLine2.JoinConnector1 = aConnector then
Angle2 := GetLineAngle(aLine2.ActualPoints[1], aLine2.ActualPoints[2]);
if aLine2.JoinConnector2 = aConnector then
Angle2 := GetLineAngle(aLine2.ActualPoints[2], aLine2.ActualPoints[1]);
end
else
begin
for i := 0 to aConnector.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(aConnector.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
if JoinedLine = aLine1 then
begin
if aLine1.JoinConnector1 = JoinedConn then
Angle1 := GetLineAngle(aLine1.ActualPoints[1], aLine1.ActualPoints[2]);
if aLine1.JoinConnector2 = JoinedConn then
Angle1 := GetLineAngle(aLine1.ActualPoints[2], aLine1.ActualPoints[1]);
end;
if JoinedLine = aLine2 then
begin
if aLine2.JoinConnector1 = JoinedConn then
Angle2 := GetLineAngle(aLine2.ActualPoints[1], aLine2.ActualPoints[2]);
if aLine2.JoinConnector2 = JoinedConn then
Angle2 := GetLineAngle(aLine2.ActualPoints[2], aLine2.ActualPoints[1]);
end;
end;
end;
end;
Result := abs(Angle1 - Angle2);
if Result > 180 then
Result := 360 - Result;
except
on E: Exception do addExceptionToLogEx('U.Common.CalcAngleBetweenLines', E.Message);
end;
end;
Function GetCheckedCornerType(aConnector: TConnectorObject): TCornerType;
var
i, j: integer;
Angle: Double;
CornerType: TCornerType;
JoinedConn1: TConnectorObject;
JoinedConn2: TConnectorObject;
JoinedLine1: TOrthoLine;
JoinedLine2: TOrthoLine;
begin
Result := crn_None; //#From Oleg# //14.09.2010
try
CornerType := aConnector.FCornerType;
Result := CornerType;
// CLEAR
if aConnector.ConnectorType = ct_Clear then
begin
// crn_None
if (aConnector.JoinedOrtholinesList.Count = 0) or (aConnector.JoinedOrtholinesList.Count = 1) or (aConnector.JoinedOrtholinesList.Count = 3) then
CornerType := crn_None;
if aConnector.JoinedOrtholinesList.Count = 2 then
begin
JoinedLine1 := TOrthoLine(aConnector.JoinedOrtholinesList[0]);
JoinedLine2 := TOrthoLine(aConnector.JoinedOrtholinesList[1]);
// crn_Vertical
if JoinedLine1.FIsRaiseUpDown or JoinedLine2.FIsRaiseUpDown then
begin
CornerType := crn_Vertical;
end
else
begin
Angle := CalcAngleBetweenLines(JoinedLine1, JoinedLine2, aConnector);
// crn_Adapter
if Angle = 180 then
begin
CornerType := crn_Adapter;
end
else
// crn_Out, crn_In
if (Angle <> 0) and (Angle <> 180) and (Angle <> 360) then
begin
if (CornerType <> crn_Out) and (CornerType <> crn_In) then
begin
//
if GCadForm.FDefaultCornerType <> crn_None then
//
CornerType := crn_Out;
end;
end;
end;
end;
end
else
// RT
begin
// crn_None
if (aConnector.JoinedConnectorsList.Count = 0) or (aConnector.JoinedConnectorsList.Count = 1) or (aConnector.JoinedConnectorsList.Count = 3) then
CornerType := crn_None;
if aConnector.JoinedConnectorsList.Count = 2 then
begin
JoinedConn1 := TConnectorObject(aConnector.JoinedConnectorsList[0]);
JoinedConn2 := TConnectorObject(aConnector.JoinedConnectorsList[1]);
if (JoinedConn1.JoinedOrtholinesList.Count = 1) and (JoinedConn2.JoinedConnectorsList.Count = 1) then
begin
JoinedLine1 := TOrthoLine(JoinedConn1.JoinedOrtholinesList[0]);
JoinedLine2 := TOrthoLine(JoinedConn2.JoinedOrtholinesList[0]);
// crn_Vertical
if JoinedLine1.FIsRaiseUpDown or JoinedLine2.FIsRaiseUpDown then
begin
CornerType := crn_Vertical;
end
else
begin
Angle := CalcAngleBetweenLines(JoinedLine1, JoinedLine2, aConnector);
// crn_Adapter
if Angle = 180 then
begin
CornerType := crn_Adapter;
end
else
// crn_Out, crn_In
if (Angle <> 0) and (Angle <> 180) and (Angle <> 360) then
begin
if (CornerType <> crn_Out) and (CornerType <> crn_In) then
begin
if GCadForm.FDefaultCornerType <> crn_None then
CornerType := crn_Out;
end;
end;
end;
end;
end;
end;
if aConnector.FCornerType <> CornerType then
begin
aConnector.FCornerType := CornerType;
Result := CornerType;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetCheckedCornerType', E.Message);
end;
end;
Function GetCornerTypeByConnectorID(AID_List, AID_Object: Integer): TCornerType;
var
FList: TF_CAD;
FFigure: TFigure;
begin
Result := crn_None; //#From Oleg# //14.09.2010
try
Result := GCadForm.FDefaultCornerType;
FList := GetListByID(AID_List);
if FList <> nil then
begin
FFigure := GetFigureByID(FList, AID_Object);
if FFigure <> nil then
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
if TConnectorObject(FFigure).FCornerTypeChangedByUser then
Result := TConnectorObject(FFigure).FCornerType
else
Result := GetCheckedCornerType(TConnectorObject(FFigure));
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetCornerTypeByConnectorID', E.Message);
end;
end;
Procedure SetCornerTypeByConnectorID(AID_List, AID_Object: Integer; ACornerType: TCornerType);
var
FList: TF_CAD;
FFigure: TFigure;
begin
try
FList := GetListByID(AID_List);
if FList <> nil then
begin
FFigure := GetFigureByID(FList, AID_Object);
if FFigure <> nil then
if CheckFigureByClassName(FFigure, cTConnectorObject) then
TConnectorObject(FFigure).FCornerType := ACornerType;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetCornerTypeByConnectorID', E.Message);
end;
end;
Procedure GetSidesByConnectedFigures(AID_List1, AID_List2, AID_Figure1, AID_Figure2: Integer; var Side1: Integer; var Side2: Integer);
var
PointObject: TConnectorObject;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
i, j, k: integer;
CurrList: TF_CAD;
Obj1, Obj2: TFigure;
List1, List2: TF_CAD;
Floor1Conn1, Floor1Conn2, Floor2Conn1, Floor2Conn2: TConnectorObject;
House: THouse;
Approach: TConnectorObject;
begin
try
Side1 := -1;
Side2 := -1;
List1 := GetListByID(AID_List1);
List2 := GetListByID(AID_List2);
if (List1 = nil) or (List2 = nil) then
Exit;
Obj1 := GetFigureByID(List1, AID_Figure1);
Obj2 := GetFigureByID(List2, AID_Figure2);
// åñëè íå íàéäåíî, òî ìîæåò ýòî äîì
if Obj1 = nil then
Obj1 := GetHouseByID(List1, AID_Figure1);
if Obj2 = nil then
Obj2 := GetHouseByID(List2, AID_Figure2);
if (Obj1 = nil) or (Obj2 = nil) then
Exit;
// îáà êîííåêòîðû
if CheckFigureByClassName(Obj1, cTConnectorObject) and CheckFigureByClassName(Obj2, cTConnectorObject) then
begin
Side1 := 0;
Side2 := 0;
end
// 1-îðòîëèíèÿ, 2-êîííåêòîð
else if CheckFigureByClassName(Obj1, cTOrthoLine) and CheckFigureByClassName(Obj2, cTConnectorObject) then
begin
Side2 := 0;
// Side = 1
if TConnectorObject(TOrthoLine(Obj1).JoinConnector1) = Obj2 then
Side1 := 1;
if TConnectorObject(TOrthoLine(Obj1).JoinConnector2) = Obj2 then
Side1 := 2;
begin
if TConnectorObject(TOrthoLine(Obj1).JoinConnector1).JoinedConnectorsList.Count > 0 then
if TConnectorObject(TOrthoLine(Obj1).JoinConnector1).JoinedConnectorsList[0] = Obj2 then
Side1 := 1;
if TConnectorObject(TOrthoLine(Obj1).JoinConnector2).JoinedConnectorsList.Count > 0 then
if TConnectorObject(TOrthoLine(Obj1).JoinConnector2).JoinedConnectorsList[0] = Obj2 then
Side1 := 2;
end;
end
// 1-êîííåêòîð, 2-îðòîëèíèÿ
else if CheckFigureByClassName(Obj1, cTConnectorObject) and CheckFigureByClassName(Obj2, cTOrthoLine) then
begin
Side1 := 0;
if TConnectorObject(TOrthoLine(Obj2).JoinConnector1) = Obj1 then
Side2 := 1;
if TConnectorObject(TOrthoLine(Obj2).JoinConnector2) = Obj1 then
Side2 := 2;
begin
if TConnectorObject(TOrthoLine(Obj2).JoinConnector1).JoinedConnectorsList.Count > 0 then
if TConnectorObject(TOrthoLine(Obj2).JoinConnector1).JoinedConnectorsList[0] = Obj1 then
Side2 := 1;
if TConnectorObject(TOrthoLine(Obj2).JoinConnector2).JoinedConnectorsList.Count > 0 then
if TConnectorObject(TOrthoLine(Obj2).JoinConnector2).JoinedConnectorsList[0] = Obj1 then
Side2 := 2;
end;
end
// 1-îðòîëèíèÿ, 2-îðòîëèíèÿ
else if CheckFigureByClassName(Obj1, cTOrthoLine) and CheckFigureByClassName(Obj2, cTOrthoLine) then
begin
// íà îäíîì ÊÀÄå
if TOrthoLine(Obj1).JoinConnector1 = TOrthoLine(Obj2).JoinConnector1 then
begin
Side1 := 1;
Side2 := 1;
end;
if TOrthoLine(Obj1).JoinConnector1 = TOrthoLine(Obj2).JoinConnector2 then
begin
Side1 := 1;
Side2 := 2;
end;
if TOrthoLine(Obj1).JoinConnector2 = TOrthoLine(Obj2).JoinConnector1 then
begin
Side1 := 2;
Side2 := 1;
end;
if TOrthoLine(Obj1).JoinConnector2 = TOrthoLine(Obj2).JoinConnector2 then
begin
Side1 := 2;
Side2 := 2;
end;
if (Side1 = -1) or (Side2 = -1) then
begin
if TConnectorObject(TOrthoLine(Obj1).JoinConnector1).JoinedConnectorsList.count > 0 then
begin
PointObject := TConnectorObject(TConnectorObject(TOrthoLine(Obj1).JoinConnector1).JoinedConnectorsList[0]);
for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(PointObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = TOrthoLine(Obj2) then
begin
Side1 := 1;
if TOrthoLine(Obj2).JoinConnector1 = JoinedConn then
Side2 := 1;
if TOrthoLine(Obj2).JoinConnector2 = JoinedConn then
Side2 := 2;
end;
end;
end;
end;
if TConnectorObject(TOrthoLine(Obj1).JoinConnector2).JoinedConnectorsList.count > 0 then
begin
PointObject := TConnectorObject(TConnectorObject(TOrthoLine(Obj1).JoinConnector2).JoinedConnectorsList[0]);
for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(PointObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = TOrthoLine(Obj2) then
begin
Side1 := 2;
if TOrthoLine(Obj2).JoinConnector1 = JoinedConn then
Side2 := 1;
if TOrthoLine(Obj2).JoinConnector2 = JoinedConn then
Side2 := 2;
end;
end;
end;
end;
end;
// ñ ó÷åòîì ìåæýòàæíûõ ïåðåõîäîâ
Floor1Conn1 := TConnectorObject(TOrthoLine(Obj1).JoinConnector1);
Floor1Conn2 := TConnectorObject(TOrthoLine(Obj1).JoinConnector2);
Floor2Conn1 := TConnectorObject(TOrthoLine(Obj2).JoinConnector1);
Floor2Conn2 := TConnectorObject(TOrthoLine(Obj2).JoinConnector2);
if (Floor1Conn1.FID_ConnToPassage = Floor2Conn1.ID) and (Floor1Conn1.ID = Floor2Conn1.FID_ConnToPassage) then
begin
Side1 := 1;
Side2 := 1;
end;
if (Floor1Conn1.FID_ConnToPassage = Floor2Conn2.ID) and (Floor1Conn1.ID = Floor2Conn2.FID_ConnToPassage) then
begin
Side1 := 1;
Side2 := 2;
end;
if (Floor1Conn2.FID_ConnToPassage = Floor2Conn1.ID) and (Floor1Conn2.ID = Floor2Conn1.FID_ConnToPassage) then
begin
Side1 := 2;
Side2 := 1;
end;
if (Floor1Conn2.FID_ConnToPassage = Floor2Conn2.ID) and (Floor1Conn2.ID = Floor2Conn2.FID_ConnToPassage) then
begin
Side1 := 2;
Side2 := 2;
end;
end;
// 1-îðòîëèíèÿ, 2-äîì
if CheckFigureByClassName(Obj1, cTOrthoLine) and CheckFigureByClassName(Obj2, cTHouse) then
begin
Side2 := 0;
JoinedConn := TConnectorObject(TOrthoLine(Obj1).JoinConnector1);
if JoinedConn.FIsHouseJoined then
if JoinedConn.FHouse = Obj2 then
Side1 := 1;
JoinedConn := TConnectorObject(TOrthoLine(Obj1).JoinConnector2);
if JoinedConn.FIsHouseJoined then
if JoinedConn.FHouse = Obj2 then
Side1 := 2;
if Side1 = -1 then
begin
House := Thouse(Obj2);
for i := 0 to House.fApproaches.Count - 1 do
begin
Approach := TConnectorObject(House.fApproaches[i]);
if Approach.JoinedConnectorsList.Count > 0 then
begin
//if Approach.JoinedConnectorsList[0] = TOrthoLine(Obj1).JoinConnector1 then
// Side1 := 1;
//if Approach.JoinedConnectorsList[0] = TOrthoLine(Obj1).JoinConnector2 then
// Side1 := 2;
//03.12.2010
for j := 0 to Approach.JoinedConnectorsList.Count - 1 do
begin
if Approach.JoinedConnectorsList[j] = TOrthoLine(Obj1).JoinConnector1 then
Side1 := 1;
if Approach.JoinedConnectorsList[j] = TOrthoLine(Obj1).JoinConnector2 then
Side1 := 2;
end;
end;
end;
end;
end
// 1-äîì, 2-îðòîëèíèÿ
else if CheckFigureByClassName(Obj1, cTHouse) and CheckFigureByClassName(Obj2, cTOrthoLine) then
begin
Side1 := 0;
JoinedConn := TConnectorObject(TOrthoLine(Obj2).JoinConnector1);
if JoinedConn.FIsHouseJoined then
if JoinedConn.FHouse = Obj1 then
Side2 := 1;
JoinedConn := TConnectorObject(TOrthoLine(Obj2).JoinConnector2);
if JoinedConn.FIsHouseJoined then
if JoinedConn.FHouse = Obj1 then
Side2 := 2;
if Side2 = -1 then
begin
House := Thouse(Obj1);
for i := 0 to House.fApproaches.Count - 1 do
begin
Approach := TConnectorObject(House.fApproaches[i]);
if Approach.JoinedConnectorsList.Count > 0 then
begin
//if Approach.JoinedConnectorsList[0] = TOrthoLine(Obj2).JoinConnector1 then
// Side2 := 1;
//if Approach.JoinedConnectorsList[0] = TOrthoLine(Obj2).JoinConnector2 then
// Side2 := 2;
//03.12.2010
for j := 0 to Approach.JoinedConnectorsList.Count - 1 do
begin
if Approach.JoinedConnectorsList[j] = TOrthoLine(Obj2).JoinConnector1 then
Side2 := 1;
if Approach.JoinedConnectorsList[j] = TOrthoLine(Obj2).JoinConnector2 then
Side2 := 2;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetSidesByConnectedFigures', E.Message);
end;
end;
Procedure GetLineFigureHeghts(AID_List, AID_Line: Integer; var AHeight1: Double; var AHeight2: Double);
var
CurLine: TOrthoLine;
vList: TF_CAD;
begin
try
AHeight1 := -1;
AHeight2 := -1;
vList := GetListByID(AID_List);
if vList <> nil then
begin
CurLine := TOrthoLine(GetFigureByID(vList, AID_Line));
if CurLine <> nil then
begin
AHeight1 := CurLine.ActualZOrder[1];
AHeight2 := CurLine.ActualZOrder[2];
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetLineFigureHeghts', E.Message);
end;
end;
procedure UpdateForLayers;
var
i: integer;
ShowLayer: TLayer;
CurrentFigure: TFigure;
begin
try
// îòîáðàæåíèå ïîäïèñåé ê îðòîëèíèÿì ïî óìîë÷àíèþ
if GCadForm.FShowLinesCaptions = True then
begin
ShowLayer := GCadForm.Pcad.Layers.Items[3];
ShowLayer.visible := seen;
end
else
begin
ShowLayer := GCadForm.Pcad.Layers.Items[3];
ShowLayer.visible := lost;
end;
// îòîáðàæåíèå ïîäïèñåé ê êîííåêòîðàì ïî óìîë÷àíèþ
if GCadForm.FShowConnectorsCaptions = True then
begin
ShowLayer := GCadForm.Pcad.Layers.Items[4];
ShowLayer.visible := seen;
end
else
begin
ShowLayer := GCadForm.Pcad.Layers.Items[4];
ShowLayer.visible := lost;
end;
// îòîáðàæåíèå âûíîñîê ê îðòîëèíèÿì ïî óìîë÷àíèþ
if GCadForm.FShowLinesNotes = True then
begin
ShowLayer := GCadForm.Pcad.Layers.Items[5];
ShowLayer.visible := seen;
end
else
begin
ShowLayer := GCadForm.Pcad.Layers.Items[5];
ShowLayer.visible := lost;
end;
// îòîáðàæåíèå âûíîñîê ê êîííåêòîðàì ïî óìîë÷àíèþ
if GCadForm.FShowConnectorsNotes = True then
begin
ShowLayer := GCadForm.Pcad.Layers.Items[6];
ShowLayer.visible := seen;
end
else
begin
ShowLayer := GCadForm.Pcad.Layers.Items[6];
ShowLayer.visible := lost;
end;
// Îáíîâèòü !!!
if F_LayersDialog.Showing then
F_LayersDialog.UpdateLayersList;
// îòîáðàæàòü äëèíû îðòîëèíèé ïî óìîë÷àíèþ
if GCadForm.FShowLinesLength = True then
begin
for i := 0 to GCadForm.PCad.Figures.Count - 1 do
begin
CurrentFigure := TFigure(GCadForm.PCad.Figures[i]);
end;
end;
if GCadForm.FShowLinesLength = False then
begin
for i := 0 to GCadForm.PCad.Figures.Count - 1 do
begin
CurrentFigure := TFigure(GCadForm.PCad.Figures[i]);
end;
end;
if GCadForm.FAutoSelectTrace = True then
FSCS_Main.aAutoSelectTrace.Checked := True;
if GCadForm.FAutoSelectTrace = False then
FSCS_Main.aAutoSelectTrace.Checked := False;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.UpdateForLayers', E.Message);
end;
end;
Procedure RefreshAllLists;
var
i: integer;
CurCAD: TF_CAD;
begin
try
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
CurCAD := TF_CAD(FSCS_Main.MDIChildren[i]);
RefreshCAD(CurCAD.PCad);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.RefreshAllLists', E.Message);
end;
end;
Procedure SetNetworkTypesForObject(AID_List, AID_Object: Integer; ANetworkTypes: TObjectNetworkTypes);
var
CurObject: TFigure;
vList: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
CurObject := GetFigureByID(vList, AID_Object);
if CheckFigureByClassName(CurObject, cTConnectorObject) then
begin
TConnectorObject(CurObject).FNetworkTypes := ANetworkTypes;
TConnectorObject(CurObject).DrawFigure.FNetworkTypes := ANetworkTypes;
end
else
if CheckFigureByClassName(CurObject, cTOrthoLine) then
begin
TOrthoLine(CurObject).FNetworkTypes := ANetworkTypes;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetNetworkTypesForObject', E.Message);
end;
end;
Function IsViewObjectInCurrentNetwork(AObject: TFigure): Boolean;
var
i: integer;
JoinedLine: TOrthoLine;
NetTypes: TObjectNetworkTypes;
begin
Result := False;
try
if (nt_All in GCadForm.FShowNetworkTypes) then
Result := True
else
begin
NetTypes := [];
if CheckFigureByClassName(AObject, cTConnectorObject) then
NetTypes := TConnectorObject(AObject).FNetworkTypes
else if CheckFigureByClassName(AObject, cTOrthoLine) then
NetTypes := TOrthoLine(AObject).FNetworkTypes
else if CheckFigureByClassName(AObject, cTFigureGrpMod) then
NetTypes := TFigureGrpMod(AObject).FNetworkTypes;
if (nt_Computer in GCadForm.FShowNetworkTypes) and (nt_Computer in NetTypes) then
result := True;
if (nt_Telephon in GCadForm.FShowNetworkTypes) and (nt_Telephon in NetTypes) then
result := True;
if (nt_Electric in GCadForm.FShowNetworkTypes) and (nt_Electric in NetTypes) then
result := True;
if (nt_Television in GCadForm.FShowNetworkTypes) and (nt_Television in NetTypes) then
result := True;
if (nt_Gas in GCadForm.FShowNetworkTypes) and (nt_Gas in NetTypes) then
result := True;
end;
{//01.11.2011
if CheckFigureByClassName(AObject, cTConnectorObject) then
begin
NetTypes := TConnectorObject(AObject).FNetworkTypes;
end;
if CheckFigureByClassName(AObject, cTOrthoLine) then
NetTypes := TOrthoLine(AObject).FNetworkTypes;
if CheckFigureByClassName(AObject, cTFigureGrpMod) then
NetTypes := TFigureGrpMod(AObject).FNetworkTypes;
if (nt_All in GCadForm.FShowNetworkTypes) then
Result := True
else
begin
if (nt_Computer in GCadForm.FShowNetworkTypes) and (nt_Computer in NetTypes) then
result := True;
if (nt_Telephon in GCadForm.FShowNetworkTypes) and (nt_Telephon in NetTypes) then
result := True;
if (nt_Electric in GCadForm.FShowNetworkTypes) and (nt_Electric in NetTypes) then
result := True;
if (nt_Television in GCadForm.FShowNetworkTypes) and (nt_Television in NetTypes) then
result := True;
if (nt_Gas in GCadForm.FShowNetworkTypes) and (nt_Gas in NetTypes) then
result := True;
end;}
except
on E: Exception do addExceptionToLogEx('U_Common.IsViewObjectInCurrentNetwork', E.Message);
end;
end;
procedure SetBlockParamsForObject(AID_List, AID_Object: Integer; ABlockGUID: string; AObjectType: Integer; ABlockStreams, ABlockStreamsOtherType: TObjectList; aSysName: string = '');
var
FFigure: TFigure;
SavedCadForm: TF_CAD;
vList: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
SavedCadForm := GCadForm;
GCadForm := vList;
FFigure := GetFigureByID(GCadForm, AID_Object);
if FFigure = nil then
FFigure := GetFigureByIDInSCSFigureGroups(GCadForm, AID_Object);
if CheckNoFigureinList(FFigure, GCadForm.FRemFigures) then
begin
if FFigure <> nil then
begin
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
if not TConnectorObject(FFigure).FIsBlockChanged then
begin
TConnectorObject(FFigure).FBlockGUID := ABlockGUID;
TConnectorObject(FFigure).FObjectType := AObjectType;
SetBlockForConnObject(TConnectorObject(FFigure), ABlockStreams, aSysName);
end;
end;
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
if not TOrthoLine(FFigure).FIsBlockChanged then
begin
TOrthoLine(FFigure).FBlockGUID := ABlockGUID;
TOrthoLine(FFigure).FObjectType := AObjectType;
SetBlockForLineObject(TOrthoLine(FFigure), ABlockStreams, ABlockStreamsOtherType);
end;
end;
end;
end;
GCadForm := SavedCadForm;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetBlockParamsForObject', E.Message);
end;
end;
procedure SetLayerHandleForFigureGrp(BlockFig: TFigureGrp; LayHandle: integer);
var
i: integer;
begin
for i := 0 to BlockFig.InFigures.Count - 1 do
begin
TFigure(BlockFig.InFigures[i]).LayerHandle := LayHandle;
if (TFigure(BlockFig.InFigures[i]) is TBlock) or (TFigure(BlockFig.InFigures[i]) is TFigureGrp) or (TFigure(BlockFig.InFigures[i]) is TFigureGrpMod)
or (TFigure(BlockFig.InFigures[i]) is TFigureGrpNotMod) then
SetLayerHandleForFigureGrp(TFigureGrp(BlockFig.InFigures[i]), LayHandle);
end;
end;
// óñòàíîâèòü íîâîå óñë.îáîçíà÷åíèå äëÿ êîííåêòîðà
Procedure SetBlockForConnObject(AConnector: TConnectorObject; ABlockStreams: TObjectList; aSysName: string = '');
var
BlockFig: TBlock;
FileName: string;
i, j: integer;
LayHandle: integer;
deltax, deltay: Double;
Bnd: TDoubleRect;
FigGroup: TFigureGrpMod;
AngleRad: Double;
AngleDeg: Double;
ABlockStream: TMemoryStream;
alldelta: double;
curdelta: double;
CadCrossObject: TCadCrossObject;
tmpAngle: Double;
begin
try
if ABlockStreams <> nil then
AConnector.FBlockCount := ABlockStreams.Count
else
AConnector.FBlockCount := 0;
// åñëè ýòî êðîññ ÀÒÑ èëè ÐØ òî ïðîðèñîâàòü åãî
if aSysName = ctsnCrossATS then
begin
if (AConnector.FTrunkName <> ctsnCrossATS) then
begin
RemoveInFigureGrp(AConnector.DrawFigure);
DeleteConnectingTraces(AConnector);
AConnector.FTrunkName := ctsnCrossATS;
CadCrossObject := GetPointObjectConnectedTrunk(GCadForm.FCADListID, AConnector.ID);
CreateCadCrossATS(aConnector, CadCrossObject);
// ïîâåðíóòü DrawFigure íà íóæíûé óãîë
AngleRad := AConnector.FDrawFigureAngle;
AngleDeg := AngleRad * 180 / pi;
RotateTrunkObject(AConnector, AngleDeg);
end;
Exit;
end
else
if aSysName = ctsnDistributionCabinet then
begin
if (AConnector.FTrunkName <> ctsnDistributionCabinet) then
begin
RemoveInFigureGrp(AConnector.DrawFigure);
DeleteConnectingTraces(AConnector);
AConnector.FTrunkName := ctsnDistributionCabinet;
CadCrossObject := GetPointObjectConnectedTrunk(GCadForm.FCADListID, AConnector.ID);
CreateCadDistribCab(aConnector, CadCrossObject);
// ïîâåðíóòü DrawFigure íà íóæíûé óãîë
AngleRad := AConnector.FDrawFigureAngle;
AngleDeg := AngleRad * 180 / pi;
RotateTrunkObject(AConnector, AngleDeg);
end;
Exit;
end;
//RefreshCAD(GCadForm.PCad);
// ïðåîáðàçîâàòü â Áëîê
{$if Defined(ES_GRAPH_SC)}
FileName := ExeDir + '\.blk\TempStream.blk';
{$else}
FileName := ExtractFileDir(Application.ExeName) + '\.blk\TempStream.blk';
{$ifend}
if (ABlockStreams <> nil) and (ABlockStreams.Count > 0) then
begin
LayHandle := GCadForm.PCad.GetLayerHandle(2);
FigGroup := TFigureGrpMod.create(LayHandle, GCadForm.PCad);
alldelta := 0;
curdelta := 0;
for i := 0 to ABlockStreams.Count - 1 do
begin
ABlockStream := TMemoryStream(ABlockStreams[i]);
if ABlockStream <> nil then
begin
// ABlockStream.SaveToFile(FileName);
// BlockFig := TBlock(GCadForm.PCad.InsertBlockwithFileName(2, FileName, -100, -100));
ABlockStream.Position := 0;
BlockFig := TBlock(GCadForm.PCad.InsertBlockFromStream(2, ABlockStream, -100, -100));
if BlockFig <> nil then
begin
try
SetLayerHandleForFigureGrp(TFigureGrp(BlockFig), LayHandle);
except
end;
if i > 0 then
begin
Bnd := BlockFig.GetBoundRect;
curdelta := abs(Bnd.Top - Bnd.Bottom) / 2;
end;
// óñòàíîâèòü DrawFigure
for j := 0 to BlockFig.InFigures.Count - 1 do
begin
FigGroup.AddFigure(TFigure(BlockFig.InFigures[j]));
TFigure(BlockFig.InFigures[j]).Move(0, alldelta + curdelta);
end;
Bnd := FigGroup.GetBoundRect;
alldelta := alldelta + abs(Bnd.Top - Bnd.Bottom) / 2;
GCadForm.PCad.Figures.Remove(BlockFig);
end;
end;
end;
//RefreshCAD(GCadForm.PCad);
tmpAngle := AConnector.FDrawFigureAngle;
AConnector.FDrawFigureAngle := 0;
AConnector.DrawFigure := FigGroup;
AConnector.FDrawFigureAngle := tmpAngle;
// ïðåîáðàçîâàòü ìàñøòàá ÓÃÎ
AConnector.SetDrawFigurePercent(AConnector.FDrawFigurePercent);
//RefreshCAD(GCadForm.PCad);
// ïîâåðíóòü DrawFigure íà íóæíûé óãîë
AngleRad := AConnector.FDrawFigureAngle;
AngleDeg := AngleRad * 180 / pi;
AConnector.DrawFigure.Rotate(AngleRad, AConnector.ActualPoints[1]);
Bnd := AConnector.DrawFigure.GetBoundRect;
//RefreshCAD(GCadForm.PCad);
AConnector.GrpSizeX := Bnd.Right - Bnd.Left;
AConnector.GrpSizeY := Bnd.Bottom - Bnd.Top;
//RefreshCAD(GCadForm.PCad);
AConnector.ReCreateCaptionsGroup(True, false);
AConnector.ReCreateNotesGroup(True);
AConnector.DefRaizeDrawFigurePos; //29.05.2013
end
else
begin
LayHandle := GCadForm.PCad.GetLayerHandle(2);
FigGroup := TFigureGrpMod.create(LayHandle, GCadForm.PCad);
AConnector.DrawFigure := FigGroup;
Bnd := AConnector.DrawFigure.GetBoundRect;
AConnector.GrpSizeX := Bnd.Right - Bnd.Left;
AConnector.GrpSizeY := Bnd.Bottom - Bnd.Top;
AConnector.ReCreateCaptionsGroup(false, false);
AConnector.DefRaizeDrawFigurePos; //29.05.2013
end;
// RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.SetBlockForConnObject', E.Message);
end;
end;
// óñòàíîâèòü íîâîå óñë.îáîçíà÷åíèå äëÿ ëèíèè
Procedure SetBlockForLineObject(ALine: TOrthoLine; ABlockStreams, ABlockStreamsOtherType: TObjectList);
var
BlockFig: TBlock;
FileName: string;
i, j, k: integer;
LayHandle: integer;
deltax, deltay: Double;
Bnd: TDoubleRect;
InFigGroup: TFigureGrpMod;
FigGroup: TFigureGrpMod;
ABlockStream: TMemoryStream;
//
delta, alldelta, curdelta: double;
begin
try
ALine.FSingleBlockDelta := 0;
LayHandle := GCadForm.PCad.GetLayerHandle(2);
//18.04.2013 if not ALine.FIsRaiseUpDown then
begin
FigGroup := TFigureGrpMod.create(LayHandle, GCadForm.PCad);
// ïðåîáðàçîâàòü â Áëîê
{$if Defined(ES_GRAPH_SC)}
FileName := ExeDir + '\.blk\TempStream.blk';
{$else}
FileName := ExtractFileDir(Application.ExeName) + '\.blk\TempStream.blk';
{$ifend}
if (ABlockStreams <> nil) and (ABlockStreams.Count > 0) then
begin
alldelta := 0;
curdelta := 0;
InFigGroup := TFigureGrpMod.create(LayHandle, GCadForm.PCad);
for i := 0 to ABlockStreams.Count - 1 do
begin
ABlockStream := TMemoryStream(ABlockStreams[i]);
if ABlockStream <> nil then
begin
ABlockStream.Position := 0;
BlockFig := TBlock(GCadForm.PCad.InsertBlockFromStream(2, ABlockStream, -100, -100));
if BlockFig <> nil then
begin
try
SetLayerHandleForFigureGrp(TFigureGrp(BlockFig), LayHandle);
except
end;
if i > 0 then
begin
Bnd := BlockFig.GetBoundRect;
end;
// óñòàíîâèòü DrawFigure
for j := 0 to BlockFig.InFigures.Count - 1 do
begin
InFigGroup.AddFigure(TFigure(BlockFig.InFigures[j]));
end;
Bnd := InFigGroup.GetBoundRect;
GCadForm.PCad.Figures.Remove(BlockFig);
end;
end;
end;
FigGroup.AddFigure(InFigGroup);
end
else
begin
InFigGroup := TFigureGrpMod.create(LayHandle, GCadForm.PCad);
FigGroup.AddFigure(InFigGroup);
end;
if (ABlockStreamsOtherType <> nil) and (ABlockStreamsOtherType.Count > 0) and (GCadForm.FShowLineCaptionsType = skExternalSCS) then
begin
alldelta := 0;
curdelta := 0;
Bnd := InFigGroup.GetBoundRect;
delta := abs(Bnd.Bottom - Bnd.Top);
delta := delta / 2;
InFigGroup := TFigureGrpMod.create(LayHandle, GCadForm.PCad);
for i := 0 to ABlockStreamsOtherType.Count - 1 do
begin
ABlockStream := TMemoryStream(ABlockStreamsOtherType[i]);
if ABlockStream <> nil then
begin
ABlockStream.Position := 0;
BlockFig := TBlock(GCadForm.PCad.InsertBlockFromStream(2, ABlockStream, -100, -100));
if BlockFig <> nil then
begin
try
SetLayerHandleForFigureGrp(TFigureGrp(BlockFig), LayHandle);
except
end;
if i > 0 then
begin
Bnd := BlockFig.GetBoundRect;
end;
// óñòàíîâèòü DrawFigure
for j := 0 to BlockFig.InFigures.Count - 1 do
begin
InFigGroup.AddFigure(TFigure(BlockFig.InFigures[j]));
TFigure(BlockFig.InFigures[j]).Move(0, delta);
end;
Bnd := InFigGroup.GetBoundRect;
GCadForm.PCad.Figures.Remove(BlockFig);
end;
end;
end;
FigGroup.AddFigure(InFigGroup);
end;
ALine.DrawFigure := FigGroup;
//if ALine.FIsRaiseUpDown then
// ALine.FDrawFigurePercent := 50;
if ALine.FDrawFigurePercent <> 100 then
if Not ALine.FIsRaiseUpDown then //27.04.2013
ChangeDrawFigurePercentForLine(ALine, ALine.FDrawFigurePercent);
// RefreshCAD(GCadForm.PCad);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetBlockForLineObject', E.Message);
end;
end;
Function CheckCanConnectInCAD(AID_List1, AID_List2, AID_Object1, AID_Object2: Integer): Boolean;
var
i, j: integer;
FList1, FList2: TF_CAD;
FFigure1, FFigure2: TFigure;
JoinedConn: TConnectorObject;
JoinedFromList: TConnectorObject;
Floor1Conn1, Floor1Conn2, Floor2Conn1, Floor2Conn2: TConnectorObject;
PointObject: TConnectorObject;
House: THouse;
Approach: TConnectorObject;
begin
Result := False;
try
FList1 := GetListByID(AID_List1);
FList2 := GetListByID(AID_List2);
if (FList1 = nil) or (FList2 = nil) then
Exit;
FFigure1 := GetFigureByID(FList1, AID_Object1);
FFigure2 := GetFigureByID(FList2, AID_Object2);
// åñëè íå íàéäåíî, òî ìîæåò ýòî äîì
if FFigure1 = nil then
FFigure1 := GetHouseByID(FList1, AID_Object1);
if FFigure2 = nil then
FFigure2 := GetHouseByID(FList2, AID_Object2);
if (FFigure1 = nil) or (FFigure2 = nil) then
Exit;
// 1 - îðòîëèíèÿ, 2 - îðòîëèíèÿ
if CheckFigureByClassName(FFigure1, cTOrthoLine) and CheckFigureByClassName(FFigure2, cTOrthoLine) then
begin
// íà îäíîì ÊÀÄå
if (TOrthoLine(FFigure1).JoinConnector1 = TOrthoLine(FFigure2).JoinConnector1) or
(TOrthoLine(FFigure1).JoinConnector1 = TOrthoLine(FFigure2).JoinConnector2) or
(TOrthoLine(FFigure1).JoinConnector2 = TOrthoLine(FFigure2).JoinConnector1) or
(TOrthoLine(FFigure1).JoinConnector2 = TOrthoLine(FFigure2).JoinConnector2) then
Result := True;
if TConnectorObject(TOrthoLine(FFigure1).JoinConnector1).JoinedConnectorsList.count > 0 then
begin
PointObject := TConnectorObject(TConnectorObject(TOrthoLine(FFigure1).JoinConnector1).JoinedConnectorsList[0]);
for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(PointObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = TOrthoLine(FFigure2) then
Result := True;
end;
end;
if TConnectorObject(TOrthoLine(FFigure1).JoinConnector2).JoinedConnectorsList.count > 0 then
begin
PointObject := TConnectorObject(TConnectorObject(TOrthoLine(FFigure1).JoinConnector2).JoinedConnectorsList[0]);
for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(PointObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = TOrthoLine(FFigure2) then
Result := True;
end;
end;
// ñ ó÷åòîì ìåæýòàæíûõ ïåðåõîäîâ
Floor1Conn1 := TConnectorObject(TOrthoLine(FFigure1).JoinConnector1);
Floor1Conn2 := TConnectorObject(TOrthoLine(FFigure1).JoinConnector2);
Floor2Conn1 := TConnectorObject(TOrthoLine(FFigure2).JoinConnector1);
Floor2Conn2 := TConnectorObject(TOrthoLine(FFigure2).JoinConnector2);
if (Floor1Conn1.FID_ConnToPassage = Floor2Conn1.ID) and (Floor1Conn1.ID = Floor2Conn1.FID_ConnToPassage) then
Result := True;
if (Floor1Conn1.FID_ConnToPassage = Floor2Conn2.ID) and (Floor1Conn1.ID = Floor2Conn2.FID_ConnToPassage) then
Result := True;
if (Floor1Conn2.FID_ConnToPassage = Floor2Conn1.ID) and (Floor1Conn2.ID = Floor2Conn1.FID_ConnToPassage) then
Result := True;
if (Floor1Conn2.FID_ConnToPassage = Floor2Conn2.ID) and (Floor1Conn2.ID = Floor2Conn2.FID_ConnToPassage) then
Result := True;
end;
// 1 - îðòîëèíèÿ, 2 - êîííåêòîð
if CheckFigureByClassName(FFigure1, cTOrthoLine) and CheckFigureByClassName(FFigure2, cTConnectorObject) then
begin
JoinedConn := TConnectorObject(TOrthoLine(FFigure1).JoinConnector1);
for i := 0 to TConnectorObject(FFigure2).JoinedConnectorsList.Count - 1 do
begin
JoinedFromList := TConnectorObject(FFigure2).JoinedConnectorsList[i];
if JoinedConn = JoinedFromList then
Result := True;
end;
JoinedConn := TConnectorObject(TOrthoLine(FFigure1).JoinConnector2);
for i := 0 to TConnectorObject(FFigure2).JoinedConnectorsList.Count - 1 do
begin
JoinedFromList := TConnectorObject(FFigure2).JoinedConnectorsList[i];
if JoinedConn = JoinedFromList then
Result := True;
end;
end;
// 1 - êîííåêòîð, 2 - îðòîëèíèÿ
if CheckFigureByClassName(FFigure1, cTConnectorObject) and CheckFigureByClassName(FFigure2, cTOrthoLine) then
begin
JoinedConn := TConnectorObject(TOrthoLine(FFigure2).JoinConnector1);
for i := 0 to TConnectorObject(FFigure1).JoinedConnectorsList.Count - 1 do
begin
JoinedFromList := TConnectorObject(FFigure1).JoinedConnectorsList[i];
if JoinedConn = JoinedFromList then
Result := True;
end;
JoinedConn := TConnectorObject(TOrthoLine(FFigure2).JoinConnector2);
for i := 0 to TConnectorObject(FFigure1).JoinedConnectorsList.Count - 1 do
begin
JoinedFromList := TConnectorObject(FFigure1).JoinedConnectorsList[i];
if JoinedConn = JoinedFromList then
Result := True;
end;
end;
// 1 - Äîì, 2 - îðòîëèíèÿ
if CheckFigureByClassName(FFigure1, cTHouse) and CheckFigureByClassName(FFigure2, cTOrthoLine) then
begin
JoinedConn := TConnectorObject(TOrthoLine(FFigure2).JoinConnector1);
if JoinedConn.FIsHouseJoined then
if JoinedConn.FHouse = THouse(FFigure1) then
Result := True;
if JoinedConn.JoinedConnectorsList.Count > 0 then
if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FIsApproach then
if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FHouse = THouse(FFigure1) then
Result := True;
JoinedConn := TConnectorObject(TOrthoLine(FFigure2).JoinConnector2);
if JoinedConn.FIsHouseJoined then
if JoinedConn.FHouse = THouse(FFigure1) then
Result := True;
if JoinedConn.JoinedConnectorsList.Count > 0 then
if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FIsApproach then
if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FHouse = THouse(FFigure1) then
Result := True;
end;
// 1 - îðòîëèíèÿ, 2 - äîì
if CheckFigureByClassName(FFigure1, cTOrthoLine) and CheckFigureByClassName(FFigure2, cTHouse) then
begin
JoinedConn := TConnectorObject(TOrthoLine(FFigure1).JoinConnector1);
if JoinedConn.FIsHouseJoined then
if JoinedConn.FHouse = THouse(FFigure2) then
Result := True;
if JoinedConn.JoinedConnectorsList.Count > 0 then
if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FIsApproach then
if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FHouse = THouse(FFigure2) then
Result := True;
JoinedConn := TConnectorObject(TOrthoLine(FFigure1).JoinConnector2);
if JoinedConn.FIsHouseJoined then
if JoinedConn.FHouse = THouse(FFigure2) then
Result := True;
if JoinedConn.JoinedConnectorsList.Count > 0 then
if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FIsApproach then
if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FHouse = THouse(FFigure2) then
Result := True;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckCanConnectInCAD', E.Message);
end;
end;
Function BriefFormat(ADbl: Double): Double;
var
Str: string;
begin
Result := 0;
try
Str := FormatFloat('0.00', ADbl);
Result := StrToFloat_My(Str);
except
on E: Exception do addExceptionToLogEx('U_Common.BriefFormat', E.Message);
end;
end;
function CheckIsNameChanged(AID_List, AID_Figure: Integer): Boolean;
var
i: integer;
FFigure: TFigure;
vList: TF_CAD;
begin
Result := True;
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
FFigure := GetFigureByID(vList, AID_Figure);
if FFigure <> nil then
begin
if CheckFigureByClassName(FFigure, cTConnectorObject) then
Result := TConnectorObject(FFigure).FIsNameChanged;
if CheckFigureByClassName(FFigure, cTOrthoLine) then
Result := TOrthoLine(FFigure).FIsNameChanged;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckIsNameChanged', E.Message);
end;
end;
function CheckIsCaptionsChanged(AID_List, AID_Figure: Integer): Boolean;
var
i: integer;
FFigure: TFigure;
vList: TF_CAD;
begin
Result := True;
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
FFigure := GetFigureByID(vList, AID_Figure);
if FFigure <> nil then
begin
if CheckFigureByClassName(FFigure, cTConnectorObject) then
Result := TConnectorObject(FFigure).FIsCaptionsChanged;
if CheckFigureByClassName(FFigure, cTOrthoLine) then
Result := TOrthoLine(FFigure).FIsCaptionsChanged;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckIsCaptionsChanged', E.Message);
end;
end;
function CheckIsNotesChanged(AID_List, AID_Figure: Integer): Boolean;
var
i: integer;
FFigure: TFigure;
vList: TF_CAD;
begin
Result := True;
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
FFigure := GetFigureByID(vList, AID_Figure);
if FFigure <> nil then
begin
if CheckFigureByClassName(FFigure, cTConnectorObject) then
Result := TConnectorObject(FFigure).FIsNotesChanged;
if CheckFigureByClassName(FFigure, cTOrthoLine) then
Result := TOrthoLine(FFigure).FIsNotesChanged;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckIsNotesChanged', E.Message);
end;
end;
function CheckIsBlockChanged(AID_List, AID_Figure: Integer): Boolean;
var
i: integer;
FFigure: TFigure;
vList: TF_CAD;
begin
Result := True;
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
FFigure := GetFigureByID(vList, AID_Figure);
if FFigure <> nil then
begin
if CheckFigureByClassName(FFigure, cTConnectorObject) then
Result := TConnectorObject(FFigure).FIsBlockChanged;
if CheckFigureByClassName(FFigure, cTOrthoLine) then
Result := TOrthoLine(FFigure).FIsBlockChanged;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckIsBlockChanged', E.Message);
end;
end;
Function GetAllConnectedTracesID(AID_List, AID_Object: Integer): TIntList;
var
i, j: integer;
CurrObject: TConnectorObject;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
vList: TF_CAD;
begin
Result := TIntList.Create;
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
CurrObject := TConnectorObject(GetFigureByID(vList, AID_Object));
if CurrObject <> nil then
begin
if CurrObject.ConnectorType = ct_Clear then
begin
for i := 0 to CurrObject.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(CurrObject.JoinedOrtholinesList[i]);
Result.Add(JoinedLine.ID);
end;
end
else
begin
for i := 0 to CurrObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(CurrObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
Result.Add(JoinedLine.ID);
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetAllConnectedTracesID', E.Message);
end;
end;
Function GetAllConnectedTraces(AObject: TConnectorObject): TList;
var
i, j: integer;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
begin
Result := TList.Create;
try
if AObject <> nil then
begin
if AObject.ConnectorType = ct_Clear then
begin
for i := 0 to AObject.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AObject.JoinedOrtholinesList[i]);
Result.Add(JoinedLine);
end;
end
else
begin
for i := 0 to AObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(AObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
Result.Add(JoinedLine);
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetAllConnectedTraces', E.Message);
end;
end;
procedure CheckBySCSObjectsNear(X, Y: Double; var ResFindedFigures: TList; TracedFigure: TFigure = nil);
var
i, j: integer;
CurFigure: TFigure;
FindedFigures: array[1..2{25}] of TList;
LHSCSCommon: Integer; // Layer Handler
Res: TFigure;
XMod, YMod: Double;
xadd, yadd: Double;
adim1, adimstep05: Double;
aZoomScaleCad: Double;
begin
Res := nil;
try
adim1 := 0.5; //1
adimstep05 := 0.25; //0.5
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 / 1.5
else
if GCadForm.PCad.ZoomScale >= 1000 then
aZoomScaleCad := GCadForm.PCad.ZoomScale / 2;
end;
if aZoomScaleCad > 0 then
begin
adim1 := adim1 / (aZoomScaleCad / 100);
adimstep05 := adimstep05 / (aZoomScaleCad / 100);
end;
for j := 1 to 2 {25} do
FindedFigures[j] := TList.Create;
if TracedFigure <> nil then
TracedFigure.Draw(GCadForm.PCad.DEngine, False);
// ïîèñê
LHSCSCommon := GCadForm.PCad.GetLayerHandle(lnSCSCommon); //15.03.2012
if GCadForm.FNeedUpdateCheckedFigures then
GCadForm.UpdateCheckedFigures;
//for i := 0 to GCadForm.PCad.FigureCount - 1 do
for i := 0 to GCadForm.FCheckedFigures.Count - 1 do
begin
//CurFigure := TFigure(GCadForm.PCad.Figures[i]);
CurFigure := TFigure(GCadForm.FCheckedFigures[i]);
if (CurFigure.LayerHandle = LHSCSCommon) then //15.03.2012
begin
XMod := X;
YMod := Y;
if CheckFigureByClassName(CurFigure, cTConnectorObject) then
begin
xadd := -adim1;
j := 1;
//// ÖÈÊË ÏÎÈÑÊÀ ÎÁÜÅÊÒÎÂ
while xadd <= adim1 do
begin
yadd := -adim1;
while yadd <= adim1 do
begin
if TConnectorObject(CurFigure).IsPointIn(XMod + xadd, YMod + yadd) then
begin
if FindedFigures[j].IndexOf(CurFigure) = -1 then
FindedFigures[j].Add(CurFigure);
end;
yadd := yadd + adimstep05;
end;
xadd := xadd + adimstep05;
end;
end
else if CheckFigureByClassName(CurFigure, cTOrthoLine) then
begin
xadd := -adim1;
j := 1;
//// ÖÈÊË ÏÎÈÑÊÀ ÎÁÜÅÊÒÎÂ
while xadd <= adim1 do
begin
yadd := -adim1;
while yadd <= adim1 do
begin
if TOrthoLine(CurFigure).IsPointIn(X + xadd, Y + yadd) then
begin
if FindedFigures[j].IndexOf(CurFigure) = -1 then
FindedFigures[j].Add(CurFigure);
end;
yadd := yadd + adimstep05;
end;
xadd := xadd + adimstep05;
end;
end
else if CheckFigureByClassName(CurFigure, cTHouse) then
begin
xadd := -adim1;
//// ÖÈÊË ÏÎÈÑÊÀ ÎÁÜÅÊÒÎÂ
while xadd <= adim1 do
begin
yadd := -adim1;
j := 1;
while yadd <= adim1 do
begin
if THouse(CurFigure).isPointInForSnap(X + xadd, Y + yadd) then
begin
if FindedFigures[j].IndexOf(CurFigure) = -1 then
FindedFigures[j].Add(CurFigure);
end;
yadd := yadd + adimstep05;
end;
xadd := xadd + adimstep05;
end;
end;
end;
end;
// âûáîð ïî êðèòåðèÿì
// ñíà÷àëà îáúåêò
for j := 1 to 2 {25} do
begin
Res := Nil;
for i := 0 to FindedFigures[j].Count - 1 do
begin
CurFigure := TFigure(FindedFigures[j][i]);
if CheckFigureByClassName(CurFigure, cTConnectorObject) and (not TConnectorObject(CurFigure).FIsApproach) then
if TConnectorObject(CurFigure).ConnectorType <> ct_Clear then
Res := CurFigure;
end;
// ïîòîì ïóñòîé êîííåêòîð
if Res = Nil then
begin
for i := 0 to FindedFigures[j].Count - 1 do
begin
CurFigure := TFigure(FindedFigures[j][i]);
if CheckFigureByClassName(CurFigure, cTConnectorObject) then
if TConnectorObject(CurFigure).ConnectorType = ct_Clear then
Res := CurFigure;
end;
end;
// íó òîãäà õîòÿ áû îðòîëèíèþ
if Res = Nil then
begin
for i := 0 to FindedFigures[j].Count - 1 do
begin
CurFigure := TFigure(FindedFigures[j][i]);
if CheckFigureByClassName(CurFigure, cTOrthoLine) then
Res := CurFigure;
end;
end;
// Ïîäúåçä
if Res = Nil then
begin
for i := 0 to FindedFigures[j].Count - 1 do
begin
CurFigure := TFigure(FindedFigures[j][i]);
if CheckFigureByClassName(CurFigure, cTConnectorObject) and (TConnectorObject(CurFigure).FIsApproach) then
Res := CurFigure;
end;
end;
// Äîì
if Res = Nil then
begin
for i := 0 to FindedFigures[j].Count - 1 do
begin
CurFigure := TFigure(FindedFigures[j][i]);
if CheckFigureByClassName(CurFigure, cTHouse) then
Res := CurFigure;
end;
end;
if Res <> nil then
begin
if ResFindedFigures.IndexOf(Res) = -1 then
ResFindedFigures.Add(Res);
end;
end;
for j := 1 to 2 {25} do
if FindedFigures[j] <> nil then
FreeAndNil(FindedFigures[j]);
if TracedFigure <> nil then
TracedFigure.Draw(GCadForm.PCad.DEngine, False);
except
on E: Exception do addExceptionToLogEx('U_Common.CheckBySCSObjectsNear', E.Message);
end;
end;
Function CheckBySCSObjects(X, Y: Double; TracedFigure: TFigure = nil): TFigure;
var
i: integer;
CurFigure: TFigure;
FindedFigures: TList;
ProgramRegisterPro_2: boolean;
addcod: integer;
LHSCSCommon: Integer; // Layer Handler
begin
Result := nil;
try
{$IF Not Defined(ES_GRAPH_SC)}
{$IF Not Defined(TRIAL_SCS)}
{$I Inc\DelphiCrcBegin.inc}
{$IFEND}
{TODO} // ïîêà çàêîìåíòèë âðåìåííî - ñëèøêîì ÷àñòî âûçûâàåòñÿ
//ProgramRegisterPro_2 := ProgProtection.IsVer2(PRO, addcod);
ProgramRegisterPro_2 := True;
addcod := 0;
{$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}
{TODO} // ïîêà çàêîìåíòèë âðåìåííî - ñëèøêîì ÷àñòî âûçûâàåòñÿ
//if Not ProgramRegisterPro_2 then
// exit;
{$IF Not Defined(TRIAL_SCS)}
{$I Inc\DelphiCrcEnd.inc}
{$IFEND}
{$IFEND}
{$ELSE}
addcod := 0;
{$IFEND}
FindedFigures := TList.Create;
if TracedFigure <> nil then
TracedFigure.Draw(GCadForm.PCad.DEngine, False);
// ïîèñê
{$IF Not Defined(ES_GRAPH_SC)}
{$IF Not Defined(TRIAL_SCS)}
{$I Inc\DelphiCrcBegin.inc}
{$IFEND}
{$IFEND}
LHSCSCommon := GCadForm.PCad.GetLayerHandle(lnSCSCommon); //15.03.2012
if GCadForm.FNeedUpdateCheckedFigures then
GCadForm.UpdateCheckedFigures;
//for i := 0 to GCadForm.PCad.FigureCount - 1 + addcod do
for i := 0 to GCadForm.FCheckedFigures.Count - 1 do
begin
//CurFigure := TFigure(GCadForm.PCad.Figures[i]);
CurFigure := TFigure(GCadForm.FCheckedFigures[i]);
if CurFigure.LayerHandle = LHSCSCommon then //15.03.2012
begin
if CheckFigureByClassName(CurFigure, cTConnectorObject) then
begin
if TConnectorObject(CurFigure).IsPointIn(X, Y) then
begin
FindedFigures.Add(CurFigure);
end;
end
else if CheckFigureByClassName(CurFigure, cTOrthoLine) then
begin
if TOrthoLine(CurFigure).IsPointIn(X + addcod, Y + addcod) then
begin
FindedFigures.Add(CurFigure);
end;
end
else if CheckFigureByClassName(CurFigure, cTHouse) then
begin
if THouse(CurFigure).isPointInForSnap(X, Y) then
begin
FindedFigures.Add(CurFigure);
end;
end;
end;
end;
// âûáîð ïî êðèòåðèÿì
{$IF Not Defined(ES_GRAPH_SC)}
{TODO} // ïîêà çàêîìåíòèë âðåìåííî - ñëèøêîì ÷àñòî âûçûâàåòñÿ
//ProgramRegisterPro_2 := ProgProtection.IsVer2(PRO, addcod);
addcod := 0;
ProgramRegisterPro_2 := True;
{$IFEND}
{$IF Not Defined(ES_GRAPH_SC)}
{$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 Not Defined(TRIAL_SCS)}
{$I Inc\DelphiCrcBegin.inc}
{$IFEND}
{$ELSE}
addcod := 0;
{$IFEND}
// ñíà÷àëà îáúåêò
for i := addcod to FindedFigures.Count - 1 do
begin
CurFigure := TFigure(FindedFigures[i]);
if CheckFigureByClassName(CurFigure, cTConnectorObject) and (not TConnectorObject(CurFigure).FIsApproach) then
if TConnectorObject(CurFigure).ConnectorType <> ct_Clear then
Result := CurFigure;
end;
{$IF Not Defined(ES_GRAPH_SC)}
{$IF Not Defined(TRIAL_SCS)}
{$I Inc\DelphiCrcEnd.inc}
{$IFEND}
{$IFEND}
// ïîòîì ïóñòîé êîííåêòîð
if Result = Nil then
begin
for i := 0 to FindedFigures.Count - 1 do
begin
CurFigure := TFigure(FindedFigures[i]);
if CheckFigureByClassName(CurFigure, cTConnectorObject) then
if TConnectorObject(CurFigure).ConnectorType = ct_Clear then
Result := CurFigure;
end;
end;
// íó òîãäà õîòÿ áû îðòîëèíèþ
if Result = Nil then
begin
for i := 0 to FindedFigures.Count - 1 do
begin
CurFigure := TFigure(FindedFigures[i]);
if CheckFigureByClassName(CurFigure, cTOrthoLine) then
Result := CurFigure;
end;
end;
// Ïîäúåçä
if Result = Nil then
begin
for i := 0 to FindedFigures.Count - 1 do
begin
CurFigure := TFigure(FindedFigures[i]);
if CheckFigureByClassName(CurFigure, cTConnectorObject) and (TConnectorObject(CurFigure).FIsApproach) then
Result := CurFigure;
end;
end;
// Äîì
if Result = Nil then
begin
for i := 0 to FindedFigures.Count - 1 do
begin
CurFigure := TFigure(FindedFigures[i]);
if CheckFigureByClassName(CurFigure, cTHouse) then
Result := CurFigure;
end;
end;
if FindedFigures <> nil then
FreeAndNil(FindedFigures);
if TracedFigure <> nil then
TracedFigure.Draw(GCadForm.PCad.DEngine, False);
except
on E: Exception do addExceptionToLogEx('U_Common.CheckBySCSObjects', E.Message);
end;
end;
Function CheckBySCSObjectsList(X, Y: Double): TList;
var
i: integer;
CurFigure: TFigure;
begin
Result := TList.Create;
try
// ïîèñê
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
CurFigure := TFigure(GCadForm.PCad.Figures[i]);
if CheckFigureByClassName(CurFigure, cTConnectorObject) then
begin
if TConnectorObject(CurFigure).IsPointIn(X, Y) then
Result.Add(CurFigure);
end;
if CheckFigureByClassName(CurFigure, cTOrthoLine) then
begin
if TOrthoLine(CurFigure).IsPointIn(X, Y) then
Result.Add(CurFigure);
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckBySCSObjectsList', E.Message);
end;
end;
Procedure AutoShiftobject(AObject: TConnectorObject);
var
i, UCount: integer;
CanMove: Boolean;
AddDelta: Double;
Bnd: TDoubleRect;
ComponWidth,
SlotsWidth,
koefX: Double;
ComponsList: TObjectList;
Obj: TWMFObject;
begin
try
if not HaveObjectSocketComponent(AObject.ID) then
Exit;
AddDelta := 0;
if BriefFormat(AObject.DrawFigure.CenterPoint.x) > BriefFormat(AObject.ActualPoints[1].x) then
CanMove := False
else
begin
if AObject.DrawFigure.InFigures.Count > 0 then
begin
CanMove := True;
if (AObject.DrawFigure.InFigures.Count = 1) and CheckFigureByClassName(TFigure(AObject.DrawFigure.InFigures[0]), 'TWMFObject') then
begin
ComponWidth := AObject.DrawFigure.GetBoundRect.Right - AObject.DrawFigure.GetBoundRect.Left;
AddDelta := 0.04 * ComponWidth;
end
else
AddDelta := 0;
end
else
CanMove := False;
end;
if CanMove then
begin
AObject.DrawFigure.Rotate(- AObject.FDrawFigureAngle, AObject.ActualPoints[1]);
Bnd := AObject.DrawFigure.GetBoundRect;
AObject.GrpSizeX := abs(Bnd.Right - Bnd.Left);
AObject.GrpSizeY := abs(Bnd.Bottom - Bnd.Top);
AObject.DrawFigure.move(AObject.GrpSizeX / 2 - AddDelta, 0);
AObject.DrawFigure.Rotate(AObject.FDrawFigureAngle, AObject.ActualPoints[1]);
Bnd := AObject.DrawFigure.GetBoundRect;
AObject.GrpSizeX := abs(Bnd.Right - Bnd.Left);
AObject.GrpSizeY := abs(Bnd.Bottom - Bnd.Top);
if AObject.CaptionsGroup <> nil then
AObject.CaptionsGroup.Move(AObject.GrpSizeX / 2 - AddDelta, 0);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.AutoShiftobject', E.Message);
end;
end;
Function GetObjectsListForCork(AListID, AID_LineFigure, ALineSide: Integer; var AID_Connector: Integer): TIntList;
var
i, j: integer;
ASelfLine: TOrthoLine;
AConnector: TConnectorObject;
GetPointObject: TConnectorObject;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
ID: Integer;
IDLine: ^Integer;
vList: TF_CAD;
begin
Result := TIntList.Create;
try
AConnector := nil; //#From Oleg# //14.09.2010
AID_Connector := -1;
vList := GetListByID(AListID);
if vList <> nil then
begin
ASelfLine := TOrthoLine(GetFigureByID(vList, AID_LineFigure));
if ASelfLine <> nil then
begin
if ALineSide = 1 then
AConnector := TConnectorObject(ASelfLine.JoinConnector1);
if ALineSide = 2 then
AConnector := TConnectorObject(ASelfLine.JoinConnector2);
// ëèñò èç ïðèñîåäèíåííûõ òðàññ
// íàïðÿìóþ
if AConnector.JoinedConnectorsList.Count = 0 then
begin
if (AConnector.FConnRaiseType <> crt_BetweenFloorUp) and (AConnector.FConnRaiseType <> crt_BetweenFloorDown) then
begin
// Âåðíóòü ÈÄ êîííåêòîðà
AID_Connector := AConnector.ID;
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]);
//New(IDLine);
//ID := JoinedLine.ID;
//IDLine^ := ID;
//Result.Add(IDLine);
Result.Add(JoinedLine.ID);
end;
end;
end
else
// ÷åðåç òî÷.îáúåêò
begin
GetPointObject := TConnectorObject(AConnector.JoinedConnectorsList[0]);
if (GetPointObject.FConnRaiseType <> crt_BetweenFloorUp) and (GetPointObject.FConnRaiseType <> crt_BetweenFloorDown) then
begin
AID_Connector := GetPointObject.ID;
for i := 0 to GetPointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(GetPointObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
//New(IDLine);
//ID := JoinedLine.ID;
//IDLine^ := ID;
//Result.Add(IDLine);
Result.Add(JoinedLine.ID);
end;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetObjectsListForCork', E.Message);
end;
end;
Procedure BeginProgress(ACaption: String = ''; AMaxPos: Integer = -1; MustShowProgress: Boolean=False);
begin
if GIsProgressHandling then
Exit;
try
if GIsProgressCount = 0 then
begin
GIsProgress := True;
GIsProgressHandling := true;
try
if not F_Progress.Visible then
if (F_Splash = nil) or Not F_Splash.Visible then
begin
try
F_Progress.StartProgress(ACaption, AMaxPos, MustShowProgress);
except
end;
end;
if assigned(F_Progress) then
begin
if F_Progress.FPauseCount = 0 then
FSCS_Main.FCADsInProgress.Clear;
end
else
FSCS_Main.FCADsInProgress.Clear;
SetCADsProgressMode(true);
BaseBeginUpdate;
except
end;
GIsProgressHandling := false;
end;
Inc(GIsProgressCount);
except
on E: Exception do addExceptionToLogEx('U_Common.BeginProgress', E.Message);
end;
end;
{
Procedure BeginProgress(ACaption: String = ''; AMaxPos: Integer = -1);
begin
if GIsProgressHandling then
Exit;
try
if GIsProgressCount = 0 then
begin
GIsProgress := True;
GIsProgressHandling := true;
try
if not F_Progress.Visible then
if (F_Splash = nil) or Not F_Splash.Visible then
begin
try
F_Progress.StartProgress(ACaption, AMaxPos);
except
end;
end;
if assigned(F_Progress) then
begin
if F_Progress.FPauseCount = 0 then
FSCS_Main.FCADsInProgress.Clear;
end
else
FSCS_Main.FCADsInProgress.Clear;
SetCADsProgressMode(true);
BaseBeginUpdate;
except
end;
GIsProgressHandling := false;
end;
Inc(GIsProgressCount);
except
on E: Exception do addExceptionToLogEx('U_Common.BeginProgress', E.Message);
end;
end;
}
Procedure EndProgress;
var
i: Integer;
begin
if GIsProgressHandling then
Exit;
try
if GIsProgressCount > 0 then
begin
Dec(GIsProgressCount);
if GIsProgressCount = 0 then
begin
GIsProgressHandling := true;
try
SetCADsProgressMode(false);
BaseEndUpdate;
if F_Progress.Visible then
begin
F_Progress.StopProgress;
end;
except
end;
GIsProgress := False;
GIsProgressHandling := false;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.EndProgress', E.Message);
end;
end;
procedure SetCADsProgressMode(AIsProgress: Boolean);
var
i: Integer;
CAD: TF_CAD;
begin
// Î÷èñòêà íà BeginProgress
// Î÷èñòêà FSCS_Main.FCADsInProgress íà BeginProgress - äåëàåòñÿ ñîáñòâåííî â BeginProgress
//if AIsProgress then
// FSCS_Main.FCADsInProgress.Clear;
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
CAD := TF_CAD(FSCS_Main.MDIChildren[i]);
if AIsProgress then
begin
//CAD.mProtocol.Properties.BeginUpdate;
//CAD.mProtocol.Lines.BeginUpdate;
//CAD.PCad.DisableAlign;
CADBeginUpdate(CAD);
if FSCS_Main.FCADsInProgress.IndexOf(CAD) = -1 then
FSCS_Main.FCADsInProgress.Add(CAD);
end
else
begin
if FSCS_Main.FCADsInProgress.IndexOf(CAD) <> -1 then
begin
//CAD.mProtocol.Properties.EndUpdate;
//CAD.mProtocol.Lines.EndUpdate;
//CAD.PCad.EnableAlign;
CADEndUpdate(CAD);
//04.04.2013 - ÍÓÆÍÎ ×ÒÎÁÛ ÍÅÁÛËÎ ÌÅÐÖÀÍÈÉ ÍÀ PauseProgress
//if CAD = FSCS_Main.ActiveMDIChild then
// RefreshCAD(CAD.PCad);
end;
end;
end;
// Î÷èñòêà íà EndProgress
if Not AIsProgress then
if assigned(F_Progress) then
begin
if F_Progress.FPauseCount = 0 then
FSCS_Main.FCADsInProgress.Clear;
end
else
FSCS_Main.FCADsInProgress.Clear;
end;
procedure CADBeginUpdate(aCAD: TObject); //07.11.2011
begin
TF_CAD(aCAD).mProtocol.Properties.BeginUpdate;
TF_CAD(aCAD).mProtocol.Lines.BeginUpdate;
TF_CAD(aCAD).PCad.DisableAlign;
TF_CAD(aCAD).PCad.BeginUpdate; //23.08.2012
end;
procedure CADEndUpdate(aCAD: TObject); //07.11.2011
begin
TF_CAD(aCAD).mProtocol.Properties.EndUpdate;
TF_CAD(aCAD).mProtocol.Lines.EndUpdate;
TF_CAD(aCAD).PCad.EnableAlign;
TF_CAD(aCAD).PCad.EndUpdate; //23.08.2012
end;
procedure StepProgress;
begin
try
if (GIsProgressCount = 1) and F_Progress.Showing then
begin
F_Progress.StepProgress;
ProcessMessagesEx;
end;
except
on E: Exception do addExceptionToLogEx('StepProgress: ', E.Message);
end;
end;
procedure StartUpProgress;
begin
F_Splash.ProgressBar.StepIt;
Application.ProcessMessages;
end;
Procedure SetListsNamesInProject(AProjectName: string);
var
i: integer;
LayerName: string;
CurCadForm: TF_CAD;
begin
try
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
CurCadForm := TF_CAD(FSCS_Main.MDIChildren[i]);
CurCadForm.FCADProjectName := AProjectName;
LayerName := CurCadForm.PCad.GetLayerName(CurCadForm.PCad.ActiveLayer);
CurCadForm.Caption := CurCadForm.FCADProjectName + ' - ' + CurCadForm.FCADListName + cCommon_Mes7 + LayerName;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetListsNamesInProject', E.Message);
end;
end;
procedure CreateShadowObject;
var
i: integer;
x, y: integer;
LayHandle: integer;
Obj: TFigureGrpNotMod;
Line: TLine;
Rect: TRectangle;
VisibleRect: TDoubleRect;
deltax, deltay: double;
isExistShadow: boolean;
Figure: TFigure;
a: integer;
begin
try
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
isExistShadow := True;
while isExistShadow do
begin
isExistShadow := False;
For a := 0 to GCadForm.PCad.Figures.Count - 1 do
begin
if TFigure(GCadForm.PCad.Figures[a]) is TFigureGrpNotMod then
if TFigureGrpNotMod(GCadForm.PCad.Figures[a]).InFigures.Count = 1 then
begin
Figure := TFigureGrpNotMod(GCadForm.PCad.Figures[a]).InFigures[0];
if Figure.ClassName = 'TLine' then
begin
isExistShadow := True;
GIsDrawShadow := False;
RemoveInFigureGrp(TFigureGrpNotMod(GCadForm.PCad.Figures[a]));
GCadForm.PCad.Figures.Remove(GCadForm.PCad.Figures[a]);
break;
end;
end;
end;
end;
VisibleRect := GCadForm.PCad.GetVisibleRect;
deltax := VisibleRect.Left + 10;
deltay := VisibleRect.Top + 10;
LayHandle := GCadForm.PCad.GetLayerHandle(2);
Obj := TFigureGrpNotMod.Create(LayHandle, GCadForm.PCad);
Line := TLine.create(0, 0, 0, 0, 1, ord(psClear), clBlack, 0, LayHandle, mydsNormal, GCadForm.PCad);
if Assigned(GShadowObject) then
GShadowObject := nil;
GShadowObject := TFigureGrpNotMod(GCadForm.PCad.AddCustomFigure (GLN(LayHandle), Obj, False));
GShadowObject.AddFigure(Line);
GShadowObject.Move(deltax, deltay);
GShadowObject.LockModify := True;
GShadowObject.LockMove := True;
{GShadowObject.DrawStyle := dsTrace;
for i := 0 to GShadowObject.inFigures.Count - 1 do
TFigure(GShadowObject.inFigures[i]).DrawStyle := dsTrace;}
{Rect := TRectangle.create(0, 0, 4, 4, 2, ord(psSolid), clGray, ord(psSolid), 0, LayHandle, mydsNormal, GCadForm.PCad);
GShadowObject := TFigureGrpNotMod(GCadForm.PCad.AddCustomFigure (GLN(LayHandle), Obj, False));
GShadowObject.AddFigure(Rect);
GShadowObject.Move(deltax, deltay);
GShadowObject.LockModify := True;
GShadowObject.LockMove := True;
GShadowObject.ShadowCP.x := deltax + 4;
GShadowObject.ShadowCP.y := deltay + 4;
Rect.DrawStyle := dsTrace;
GShadowObject.DrawStyle := dsTrace;
GCadForm.PCad.TraceFigure := GShadowObject;}
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CreateShadowObject', E.Message);
end;
end;
procedure DestroyShadowObject;
var
i: integer;
begin
try
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
//GCadForm.PCad.TraceFigure := nil; //16.03.2012
GIsDrawShadow := False;
if GShadowObject <> nil then
begin
RemoveInFigureGrp(GShadowObject);
GCadForm.PCad.Figures.Remove(GShadowObject);
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.DestroyShadowObject', E.Message);
end;
if (GCadForm.FCreateObjectOnClick){and(not Assigned(GShadowObject))} then
CreateShadowObject; // Íà CAD
end;
Procedure AutoConnectOverRaiseInCAD(AObjFromRaise, ARaiseObj: TConnectorObject);
var
i, j: integer;
ObjFromRaise: TConnectorObject;
RaiseObj: TConnectorObject;
RaiseLine: TOrthoLine;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
ptrConnectObjParam: PConnectObjectParam;
ConnectedLines: TList;
ConnectedBeforeRaise: TList;
ConnectedAfterRaise: TList;
procedure DefineConnectedObjectParams(ATargetConnectedObjectParams: TList; AConnectorObject: TConnectorObject);
var
i, j: Integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
ptrConnectObjParam: PConnectObjectParam;
begin
if AConnectorObject.ConnectorType = ct_Clear then
for i := 0 to AConnectorObject.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnectorObject.JoinedOrtholinesList[i]);
if JoinedLine <> RaiseLine then
begin
New(ptrConnectObjParam);
ptrConnectObjParam.IDObject := JoinedLine.ID;
if JoinedLine.JoinConnector1 = AConnectorObject then
ptrConnectObjParam.Side := 1;
if JoinedLine.JoinConnector2 = AConnectorObject then
ptrConnectObjParam.Side := 2;
ATargetConnectedObjectParams.Add(ptrConnectObjParam);
end;
end
else
begin
for i := 0 to AConnectorObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(AConnectorObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
if JoinedLine <> RaiseLine then
begin
New(ptrConnectObjParam);
ptrConnectObjParam.IDObject := JoinedLine.ID;
if JoinedLine.JoinConnector1 = JoinedConn then
ptrConnectObjParam.Side := 1;
if JoinedLine.JoinConnector2 = JoinedConn then
ptrConnectObjParam.Side := 2;
ATargetConnectedObjectParams.Add(ptrConnectObjParam);
end;
end;
end;
end;
end;
begin
try
ObjFromRaise := AObjFromRaise;
RaiseObj := ARaiseObj;
if (ARaiseObj.FConnRaiseType = crt_None) and (AObjFromRaise.FConnRaiseType <> crt_None) then
begin
ObjFromRaise := ARaiseObj;
RaiseObj := AObjFromRaise;
end;
RaiseLine := GetRaiseLine(RaiseObj);
ConnectedBeforeRaise := TList.Create;
ConnectedAfterRaise := TList.Create;
DefineConnectedObjectParams(ConnectedBeforeRaise, ObjFromRaise);
DefineConnectedObjectParams(ConnectedAfterRaise, RaiseObj);
AutoConnectOverRaiseLine(ObjFromRaise.ID, RaiseLine.ID, ConnectedBeforeRaise, ConnectedAfterRaise, ltUpDown);
if ConnectedBeforeRaise <> nil then
FreeList(ConnectedBeforeRaise);
if ConnectedAfterRaise <> nil then
FreeList(ConnectedAfterRaise);
except
on E: Exception do addExceptionToLogEx('U_Common.AutoConnectOverRaiseInCAD', E.Message);
end;
end;
function GetCADStreamByIDList(AID_List: Integer; aFileName: string = ''): TMemoryStream;
var
i: integer;
CurCADForm: TF_CAD;
begin
Result := nil; //09.09.2011 TMemoryStream.Create;
try
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
if TF_CAD(FSCS_Main.MDIChildren[i]).FCADListID = AID_List then
Break;
end;
if i = FSCS_Main.MDIChildCount then
Exit;
CurCADForm := TF_CAD(FSCS_Main.MDIChildren[i]);
GCadForm := CurCADForm;
if GCadForm <> nil then
begin
GCadForm.PCad.SaveWithPreview := False;
if aFileName = '' then
begin
Result := TMemoryStream.Create;
GCadForm.PCad.SaveToStream(Result)
end
else
begin
ForceDirectories(ExtractFileDir(aFileName));
GCadForm.PCad.SaveToFile(0, aFileName);
end;
GCadForm.PCad.SaveWithPreview := True;
end;
except
on E: Exception do addExceptionToLogEx('GetCADStreamByIDList', E.Message);
end;
end;
function IfDrawFigureMoveCan(AObject: TConnectorObject; ADeltaX, ADeltaY: Double): Boolean;
var
BegPoints: TDoublePoint;
EndPoints: TDoublePoint;
ToPoints: TDoublePoint;
begin
Result := False;
try
BegPoints.x := AObject.ActualPoints[1].x - AObject.GrpSizeX / 2;
BegPoints.y := AObject.ActualPoints[1].y - AObject.GrpSizeY / 2;
EndPoints.x := AObject.ActualPoints[1].x + AObject.GrpSizeX / 2;
EndPoints.y := AObject.ActualPoints[1].y + AObject.GrpSizeY / 2;
ToPoints.x := AObject.DrawFigure.CenterPoint.x + ADeltaX;
ToPoints.y := AObject.DrawFigure.CenterPoint.y + ADeltaY;
if ((ToPoints.x >= BegPoints.x) and (ToPoints.x <= EndPoints.x)) and ((ToPoints.y >= BegPoints.y) and (ToPoints.y <= EndPoints.y)) then
Result := True;
except
on E: Exception do addExceptionToLogEx('U_Common.IfDrawFigureMoveCan', E.Message);
end;
end;
procedure ReAssignNavigatorParams;
var
i: integer;
ListValue: Double;
BaseValue: Double;
KoefValue: Double;
begin
try
if F_Navigator <> nil then
begin
if F_Navigator.PCadNavigator.SelectedCount > 0 then
F_Navigator.PCadNavigator.DeselectAll(0);
if (F_Navigator.PCadNavigator.PageOrient <> GCadForm.PCad.PageOrient) or
(F_Navigator.PCadNavigator.PageLayout <> GCadForm.PCad.PageLayout) then
begin
F_Navigator.PCadNavigator.PageOrient := GCadForm.PCad.PageOrient;
F_Navigator.PCadNavigator.PageLayout := GCadForm.PCad.PageLayout;
F_Navigator.PCadNavigator.WorkWidth := GCadForm.PCad.WorkWidth;
F_Navigator.PCadNavigator.WorkHeight := GCadForm.PCad.WorkHeight;
// A0 - 1189*841 - 3% ZoomScale
// A1 - 841*594
// A2 - 594*421
// A3 - 421*297
// A4 - 297*210
// A5 - 210*148
// A6 - 105*74
BaseValue := 1189;
ListValue := Max(GCadForm.PCad.WorkHeight, GCadForm.PCad.WorkWidth);
KoefValue := BaseValue / ListValue;
F_Navigator.PCadNavigator.ZoomScale := Round(3 * KoefValue);
end;
RefreshCAD(F_Navigator.PCadNavigator);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ReAssignNavigatorParams', E.Message);
end;
end;
Procedure LoadSettingsForList(AListID: Integer; aApplyListFormat: Boolean);
var
ListSettings: TListSettingRecord;
ListParams: TListParams;
begin
try
SetDefaultPageParams;
// ïîäãðóçèòü ïàðàìåòðû ëèñòà
ListParams := GetListParams(AListID);
LoadSettingsForListByParams(ListParams, aApplyListFormat);
except
on E: Exception do addExceptionToLogEx('U_Common.LoadSettingsForList', E.Message);
end;
end;
function MakeEditList(AMakeEdit: TMakeEdit; var AListParams: TListParams; AShowForm: Boolean;
ASpravochnikKind: TViewKind = vkNone; AGUIDToLocate: String = ''): Boolean;
var
NewTab: TTabSheet;
MenuItem: TMenuItem;
i, j: integer;
GetIDList: Integer;
OldPrjCaption, PrjCaption: string;
OldListCaption, ListCaption: String;
Box: TConnectorObject;
BoxList: TF_CAD;
WasOpenedProject: Boolean;
CADParams: TCADParams;
Cabinet: TCabinet;
x1, x2, y1, y2: double;
LHandle: integer;
OldListParams: TListParams;
OldListW, OldListH: double;
isChangeListParams: Boolean;
begin
Result := false;
try
if not CanAddListToPM(WasOpenedProject) then
begin
ShowMessage(cCommon_Mes8);
Exit;
end;
OldListW := 0; //#From Oleg# //14.09.2010
OldListH := 0; //#From Oleg# //14.09.2010
//*** Íà ñëó÷àé, åñëè Ëèñò ñîçäàåòñÿ íà çàêðûòîì ïðîåêòå, è ïàðàìåòðû äî òåê. ìîìåíòà
// íåáûëè îïðåäåëåíû
if WasOpenedProject then ///if AListParams.MarkID = 0 then
AListParams := GetListParamsForNewList;
OldListParams := AListParams;
CADParams := SetCADParamsStruct(AListParams);
// &&&
if (GIfMasterUsed) or (GLiteVersion and (AMakeEdit = meMake)) and (not GReadOnlyMode) then
isChangeListParams := F_MasterNewListLite.ChangeListParams(AMakeEdit, AListParams, AShowForm{, CADParams}, ASpravochnikKind, AGUIDToLocate)
else
isChangeListParams := F_MasterNewList.ChangeListParams(AMakeEdit, AListParams, AShowForm{, CADParams}, ASpravochnikKind, AGUIDToLocate);
if isChangeListParams then
begin
Result := true;
BeginProgress;
try
// MAKE
if AMakeEdit = meMake then
begin
// ñîçäàòü ëèñò â ïðîåêòå
TF_CAD.Create(FSCS_Main);
// ñîçäàòü âèðòóàëüíûé êàáèíåò
CreateVirtualCabinetInCAD(GCadForm);
if GCurrentCADListID = 0 then
begin
GetIDList := GenNewListID;
GCadForm.FCADListID := GetIDList;
AListParams.ID := GCadForm.FCADListID;
end
else
GCadForm.FCADListID := GCurrentCADListID;
GCadForm.FCADListName := AListParams.Name;
GCadForm.FCADListIndex := AListParams.MarkID;
SetDefaultPageParams;
// Äîáàâèòü ïåðåêëþ÷àòåëü â ïàíåëü ëèñòîâ ïðîåêòà
NewTab := TTabSheet.Create(nil);
NewTab.PageControl := FSCS_Main.pageCADList;
NewTab.Tag := GCadForm.Handle;
FSCS_Main.pageCADList.ActivePage := NewTab;
// Äîáàâèòü Ëèñòû â ãëàâíîå ìåíþ
for i := 0 to FSCS_Main.mainWindow.Count - 1 do
if FSCS_Main.mainWindow.Items[i].Caption = '-' then
break;
j := 0;
inc(i);
while FSCS_Main.mainWindow.Count > i do
begin
MenuItem := FSCS_Main.mainWindow.Items[FSCS_Main.mainWindow.Count - 1];
FSCS_Main.mainWindow.Delete(FSCS_Main.mainWindow.Count - 1);
MenuItem.Free;
end;
for j := 0 to FSCS_Main.pageCADList.PageCount - 1 do
begin
MenuItem := TMenuItem.Create(nil);
MenuItem.Caption := FSCS_Main.pageCADList.Pages[j].Caption;
MenuItem.Tag := FSCS_Main.pageCADList.Pages[j].Tag;
MenuItem.AutoCheck := True;
MenuItem.RadioItem := True;
MenuItem.Checked := FSCS_Main.pageCADList.Pages[j] = FSCS_Main.pageCADList.ActivePage;
MenuItem.OnClick := FSCS_Main.SwitchWindow;
FSCS_Main.mainWindow.Add(MenuItem);
end;
// Ñîçäàòü ëèñò â ÌÏ
if (F_NormBase <> nil) and (F_ProjMan <> nil) then
if GCurrentCADListID = 0 then
AddListInPM(GCadForm.FCADListID, AListParams);
GCadForm.WindowState := wsMaximized;
GCadForm.FCADProjectName := GetCurrProjectName;
PrjCaption := GetCurrProjectParams.Caption;
ListCaption := AListParams.Caption;
GCadForm.Caption := PrjCaption + ' - ' + ListCaption;
{$IF Defined(ES_GRAPH_SC)}
GCadForm.CurrentLayer := 8;
{$else}
GCadForm.CurrentLayer := 2;
{$ifend}
end;
// ***
// óñòàíîâèòü ïàðàìåòðû òàáîâ è âêëàäîê
PrjCaption := GetCurrProjectParams.Caption;
ListCaption := AListParams.Caption;
FSCS_Main.pageCADList.ActivePage.Caption := ListCaption;
for i := 0 to FSCS_Main.mainWindow.Count - 1 do
begin
if FSCS_Main.mainWindow.Items[i].Checked then
break;
end;
FSCS_Main.mainWindow.Items[i].Caption := ListCaption;
// *UNDO*
if AMakeEdit = meEdit then
begin
if GCadForm <> nil then
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
end;
if AMakeEdit = meEdit then
if GCadForm <> nil then
begin
OldListW := GCadForm.PCad.WorkWidth;
OldListH := GCadForm.PCad.WorkHeight;
end;
// óñòàíîâèòü ïàðàìåòðû ëèñòà îò ìàñòåðà ñîçäàíèÿ ëèñòà
LoadSettingsForListByParams(AListParams, True);
SaveListParams(GCadForm.FCADListID, AListParams, F_MasterNewList.cbApplyForAllSCSObjects.Checked, F_MasterNewList.cbApplyForSelectedOnly.Checked);
if (GIfMasterUsed) or (GLiteVersion and (AMakeEdit = meMake)) and (not GReadOnlyMode) then
SetNewListParamsForMaster(CADParams)
else
SetNewListParams(CADParams);
if AMakeEdit = meMake then
if GCadForm <> nil then
begin
if GCadForm.FListType = lt_Normal then
{$IF Defined(ES_GRAPH_SC)}
GCadForm.CurrentLayer := 8
{$else}
GCadForm.CurrentLayer := 2
{$ifend}
else
GCadForm.CurrentLayer := 1;
end;
// *** EDIT ***
if AMakeEdit = meEdit then
begin
if GCadForm.FListType = lt_DesignBox then
begin
// Îáíîâèòü äèçàéí-ëèñò
BoxList := GetListByID(GCadForm.FJoinedListIDForDesignList);
if BoxList <> nil then
begin
Box := TConnectorObject(GetFigureByID(BoxList, GCadForm.FJoinedBoxIDForDesignList));
if Box <> nil then
UpdateDesignList(GCadForm, Box);
end;
end;
//
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
try
if (OldListParams.MarkID <> AListParams.MarkID) or (OldListParams.Name <> AListParams.Name) then
// 2011-05-10
RenameListInCAD(GCadForm.FCADListID, '', AListParams.Caption, @AListParams, false);
except
end;
end;
// îáíîâèòü èìÿ ëèñòà íà ðàìêå
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
try
//13.09.2010 if (GCadForm.FFrameListName = nil) or (TRichText(GCadForm.FFrameListName).re.Text = '') then
//13.09.2010 RenameListOnFrame(GCadForm, GetCurrProjectParams(false), OldListParams);
RenameListOnFrame(GCadForm, GetCurrProjectParams(false), OldListParams);
except
end;
end;
// àâòîïîäãîíêà èçîáðàæåíèÿ
if AMakeEdit = meEdit then
if F_MasterNewList.cbRescaleDrawing.Enabled and F_MasterNewList.cbRescaleDrawing.Checked then
if GCadForm <> nil then
ReScaleDrawingToListFormat(OldListW, OldListH);
// *UNDO*
if GCadForm <> nil then
GCadForm.FCanSaveForUndo := True;
end;
finally
EndProgress;
GIfMasterUsed := False;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.MakeEditList', E.Message);
end;
end;
procedure LoadSettingsForListByParams(AListParams: TListParams; aApplyListFormat: Boolean);
var
ListSettings: TListSettingRecord;
ListFormat: TListFormatType;
IsChanged: Boolean;
begin
try
ListSettings := AListParams.Settings;
//06.08.2012
GCadForm.PCad.FGrayedColor := AListParams.Settings.CADGrayedColor;
GCadForm.FCADListIndex := AListParams.MarkID;
GCadForm.FCADListIndex := AListParams.MarkID;
GCadForm.FRoomHeight := ListSettings.HeightRoom;
GCadForm.FFalseFloorHeight := ListSettings.HeightCeiling;
GCadForm.FConnHeight := ListSettings.HeightSocket;
GCadForm.FLineHeight := ListSettings.HeightCorob;
GCadForm.FLengthKoef := ListSettings.LengthKoef;
GCadForm.FPortReserv := ListSettings.PortReserv;
GCadForm.FMultiportReserv := ListSettings.MultiportReserv;
GCadForm.FCableChannelFullnessKoef := ListSettings.CableCanalFullnessKoef;
GCadForm.FTwistedPairMaxLength := ListSettings.TwistedPairMaxLength;
//
GCadForm.FShowObjectCaptionsType := ListSettings.ShowObjectTypeCAD;
GCadForm.FShowObjectNotesType := ListSettings.CADShowObjectNotesType;
GCadForm.FShowLineCaptionsType := ListSettings.CADCaptionsKind;
GCadForm.FShowLineNotesType := ListSettings.CADNotesKind;
//
GCadForm.FGroupListObjectsByType := ListSettings.GroupListObjectsByType;
GCadForm.FPutCableOnTrace := ListSettings.PutCableInTrace;
GCadForm.FShowLinesLength := ListSettings.ShowLineObjectLength;
GCadForm.FShowLinesCaptions := ListSettings.ShowLineObjectCaption;
GCadForm.FShowConnectorsCaptions := ListSettings.ShowConnObjectCaption;
GCadForm.FShowLinesNotes := ListSettings.ShowLineObjectNote;
GCadForm.FShowConnectorsNotes := ListSettings.ShowConnObjectNote;
GCadForm.FDefaultTraceColor := ListSettings.CADTraceColor;
GCadForm.FDefaultBlockStep := ListSettings.CADBlockStep;
GCadForm.FDefaultTraceStyle := ListSettings.CADTraceStyle;
GCadForm.FDefaultTraceWidth := ListSettings.CADTraceWidth;
GCadForm.FClickType := ListSettings.CADClickObjectType;
GCadForm.FShowRaise := ListSettings.CADShowRaise;
//GCadForm.FShowRaiseDrawFigure := ListSettings.CADShowRaiseDrawFigure;
GCadForm.FNotePrefix := ListSettings.NoteCountPrefix;
GCadForm.PCad.GridStep := ListSettings.CADGridStep;
// Øðèôò ÊÀÄà
GCadForm.FFontName := ListSettings.CADFontName;
GCadForm.PCad.Font.Name := GCadForm.FFontName;
// Òèï óãîëêà ïî äåôîëòó
GCadForm.FDefaultCornerType := ListSettings.CornerType;
GCadForm.FKeepLineTypesRules := ListSettings.KeepLineTypesRules;
// Îáíîâèòü âñå òåêñòû íà ëèñòå
UpdateForTexts(GCadForm.FFontName);
GCadForm.FListType := ListSettings.ListType;
if GCadForm.FListType = lt_Normal then
EnableOptionsForNormalList;
if GCadForm.FListType = lt_DesignBox then
DisableOptionsForDesignList;
if GCadForm.FListType = lt_ProjectPlan then
DisableOptionsForProjectPlan;
// Äëÿ äèçàéíåðñêîãî ëèñòà
GCadForm.FJoinedBoxIDForDesignList := ListSettings.IDFigureForDesignList;
GCadForm.FJoinedListIDForDesignList := ListSettings.IDListForDesignList;
GCadForm.FDesignListShowName := ListSettings.ShowNameInDesignList;
GCadForm.FDesignListShowSign := ListSettings.ShowNameShortInDesignList;
GCadForm.FDesignListShowMark := ListSettings.ShowNameMarkInDesignList;
// ÏÀÐÀÌÅÒÐÛ ÑÒÐÀÍÈÖÛ
// çàïîëíèòü ñòðóêòóðó ôîðìàòà ëèñòà
ListFormat.ListCountX := ListSettings.CADListCountX;
ListFormat.ListCountY := ListSettings.CADListCountY;
ListFormat.PageWidth := ListSettings.CADWidth * ListSettings.CADListCountX;
ListFormat.PageHeight := ListSettings.CADHeight * ListSettings.CADListCountY;
ListFormat.ShowMainStamp := ListSettings.CADShowMainStamp;
ListFormat.ShowUpperStamp := ListSettings.CADShowUpperStamp;
ListFormat.ShowSideStamp := ListSettings.CADShowSideStamp;
ListFormat.StampLang := ListSettings.CADStampLang;
ListFormat.StampType := ListSettings.CADStampType;
ListFormat.StampFields.Margins := ListSettings.CADStampMargins;
ListFormat.StampFields.Developer := ListSettings.CADStampDeveloper; //15.11.2011 - ðàçðàáîòàë
ListFormat.StampFields.Checker := ListSettings.CADStampChecker; //15.11.2011 - ïðîâåðèë
ListFormat.StampFields.ListSign := ListSettings.CADStampListSign;
ListFormat.StampFields.MainEngineer := ListSettings.CADStampMainEngineer; //02.10.2012 - Ãëàâíûé èíæåíåð ïðîåêòà
ListFormat.StampFields.Approved := ListSettings.CADStampApproved; //02.10.2012 - Óòâåðäèë
ListFormat.StampFields.DesignStage := ListSettings.CADStampDesignStage; //02.10.2012 - Ñòàäèÿ ïðîåêòèð.
if ListSettings.CADPageSizeIndex = 0 then
ListFormat.PageLayout := plA0;
if ListSettings.CADPageSizeIndex = 1 then
ListFormat.PageLayout := plA1;
if ListSettings.CADPageSizeIndex = 2 then
ListFormat.PageLayout := plA2;
if ListSettings.CADPageSizeIndex = 3 then
ListFormat.PageLayout := plA3;
if ListSettings.CADPageSizeIndex = 4 then
ListFormat.PageLayout := plA4;
if ListSettings.CADPageSizeIndex = 5 then
ListFormat.PageLayout := plA5;
if ListSettings.CADPageSizeIndex = 6 then
ListFormat.PageLayout := plA6;
if ListSettings.CADPageSizeIndex = 7 then
ListFormat.PageLayout := plB4;
if ListSettings.CADPageSizeIndex = 8 then
ListFormat.PageLayout := plB5;
if ListSettings.CADPageSizeIndex = 9 then
ListFormat.PageLayout := plLetter;
if ListSettings.CADPageSizeIndex = 10 then
ListFormat.PageLayout := plTabloid;
if ListSettings.CADPageSizeIndex = 11 then
ListFormat.PageLayout := plCustom;
if ListSettings.CADPageOrient = PCTypesUtils.poPortrait then
ListFormat.PageOrient := PCTypesUtils.poPortrait
else
if ListSettings.CADPageOrient = PCTypesUtils.poLandscape then
ListFormat.PageOrient := PCTypesUtils.poLandscape;
// ïðîâåðèòü áûëè ëè èçìåíåíèÿ
IsChanged := CheckListFormatChanged(GCadForm, ListFormat);
GCadForm.FCadStampType := ListSettings.CADStampType;
GCadForm.FCadStampLang := ListSettings.CADStampLang;
//GCadForm.FCadStampMargins := ListSettings.CADStampMargins;
//GCadForm.FCADStampDeveloper := ListSettings.CADStampDeveloper;
//GCadForm.FCADStampChecker := ListSettings.CADStampChecker;
GCadForm.FStampFields := ListFormat.StampFields;
GCadForm.FListCountX := ListSettings.CADListCountX;
GCadForm.FListCountY := ListSettings.CADListCountY;
GCadForm.FShowMainStamp := ListSettings.CADShowMainStamp;
GCadForm.FShowUpperStamp := ListSettings.CADShowUpperStamp;
GCadForm.FShowSideStamp := ListSettings.CADShowSideStamp;
//GCadForm.FShowPathLengthType := TShowPathLengthType(ListSettings.CADShowPathLengthType);
GCadForm.SetShowPathLengthType(TShowPathLengthType(ListSettings.CADShowPathLengthType));
//GCadForm.FShowPathTraceLengthType := TShowPathLengthType(ListSettings.CADShowPathTraceLengthType);
GCadForm.SetShowPathTraceLengthType(TShowPathLengthType(ListSettings.CADShowPathTraceLengthType));
if aApplyListFormat and IsChanged then
SetCadListFormat(ListFormat);
// íàñòðîéêè ÊÀÄà
// ïîêàçûâàòü ëèíåéêè
GCadForm.PCad.RulerVisible := ListSettings.CADShowRuler;
FSCS_Main.aShowRuler.Checked := GCadForm.PCad.RulerVisible;
GCadForm.tbShowRuler.Down := GCadForm.PCad.RulerVisible;
// ïîêàçûâàòü ñåòêó
GCadForm.PCad.Grids := ListSettings.CADShowGrid;
FSCS_Main.aShowGrid.Checked := GCadForm.PCad.Grids;
GCadForm.tbShowGrid.Down := GCadForm.PCad.Grids;
// ïîêàçûâàòü öåíòð. íàïðàâëÿþùèå
// FSCS_Main.aShowCenterGuides.Checked := GCadForm.PCad.CenterGuide;
// ïîêàçûâàòü íàïðàâëÿþùèå
GCadForm.PCad.GuidesVisible := ListSettings.CADShowGuides;
FSCS_Main.aShowGuideLines.Checked := GCadForm.PCad.GuidesVisible;
GCadForm.tbShowGuides.Down := GCadForm.PCad.GuidesVisible;
// ïðèâÿçêà ê ñåòêå
GCadForm.PCad.SnapToGrids := ListSettings.CADSnapGrid;
FSCS_Main.aSnaptoGrid.Checked := GCadForm.PCad.SnapToGrids;
GCadForm.tbSnapGrid.Down := GCadForm.PCad.SnapToGrids;
GCadForm.LastSnapGridStatus := GCadForm.PCad.SnapToGrids;
// ïðèâÿçêà ê íàïðàâëÿþùèì
GCadForm.PCad.SnapToGuides := ListSettings.CADSnapGuides;
FSCS_Main.aSnaptoGuides.Checked := GCadForm.PCad.SnapToGuides;
GCadForm.tbSnapGuides.Down := GCadForm.PCad.SnapToGuides;
// ïðèâÿçêà ê áëèæ. îáúåêòó
GCadForm.PCad.SnapToNearPoint := ListSettings.CADSnapNearObject;
FSCS_Main.aSnaptoNearObject.Checked := GCadForm.PCad.SnapToNearPoint;
GCadForm.tbSnapNearObject.Down := GCadForm.PCad.SnapToNearPoint;
// ñòèëü îòîáðàæåíèÿ èçìåðèòåëüíûõ ëèíèé
GCadForm.FDimLinesType := ListSettings.CADDimLinesType;
// îáíîâèòü ñëîè
UpdateForLayers;
// îòîáðàæåíèå íîìåðîâ êàáèíåòîâ
GCadForm.FShowCabinetsNumbers := ListSettings.CADShowCabinetsNumbers;
GCadForm.FShowCabinetsBounds := ListSettings.CADShowCabinetsBounds;
// öâåòà ïîäïèñåé è âûíîñîê
GCadForm.FLinesCaptionsColor := ListSettings.CADLinesCaptionsColor;
GCadForm.FConnectorsCaptionsColor := ListSettings.CADConnectorsCaptionsColor;
GCadForm.FLinesNotesColor := ListSettings.CADLinesNotesColor;
GCadForm.FConnectorsNotesColor := ListSettings.CADConnectorsNotesColor;
// ðàçìåðû øðèôòîâ ïîäïèñåé è âûíîñîê
GCadForm.FLinesCaptionsFontSize := ListSettings.CADLinesCaptionsFontSize;
GCadForm.FConnectorsCaptionsFontSize := ListSettings.CADConnectorsCaptionsFontSize;
GCadForm.FLinesNotesFontSize := ListSettings.CADLinesNotesFontSize;
GCadForm.FConnectorsNotesFontSize := ListSettings.CADConnectorsNotesFontSize;
GCadForm.FCrossATSFontSize := ListSettings.CADCrossATSFontSize;
GCadForm.FCrossATSFontBold := ListSettings.CADCrossATSFontBold;
GCadForm.FDistribCabFontSize := ListSettings.CADDistribCabFontSize;
GCadForm.FDistribCabFontBold := ListSettings.CADDistribCabFontBold;
GCadForm.FPrintType := ListSettings.CADPrintType;
GCadForm.FSCSType := ListSettings.SCSType;
GCadForm.FDefaultTraceStepRotate := ListSettings.CADTraceStepRotate;
GCadForm.FAutoCadMouse := ListSettings.AutoCadMouse;
GCadForm.FScaleByCursor := ListSettings.ScaleByCursor;
GCadForm.FAutoPosTraceBetweenRM := ListSettings.CADAutoPosTraceBetweenRM;
GCadForm.FSaveUndoCount := ListSettings.CADSaveUndoCount;
GCadForm.FActiveActions := 0;
GCadForm.FAllowSuppliesKind := ListSettings.CADAllowSuppliesKind;
GCadForm.FNewTraceLengthType := TTraceLengthType(ListSettings.CADNewTraceLengthType);
GCadForm.FListSettings := ListSettings;
except
on E: Exception do addExceptionToLogEx('U_Common.LoadSettingsForListByParams', E.Message);
end;
end;
procedure SetCADFrameParams(ACadForm: TF_CAD);
var
//ListParams: TListParams;
//ProjectParams: TProjectParams;
CadForm: TF_CAD;
begin
try
// ïîäãðóçèòü ïàðàìåòðû ëèñòà
//ListParams := GetListParams(AListID);
//ProjectParams := GetCurrProjectParams(false);
CadForm := ACadForm; //GetListByID(AListID);
if CadForm <> nil then
begin
LoadCaptionsOnFrame(CadForm, CadForm.FCadStampType, false);
// íîìåð ëèñòà
//if GCadForm.FFrameListName <> nil then
//begin
// GCadForm.PCad.Figures.Remove(GCadForm.FFrameListName);
// RefreshCad(GCadForm.PCad);
// GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName);
// GCadForm.FFrameListName.DataID := 200;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameListName, False);
//end;
end;
except
on E: Exception do AddExceptionToLogEx('SetCADFrameParams', E.Message);
end;
end;
// ÎÒÊÐÛÒÜ ËÈÑÒÛ Â ÏÐÎÅÊÒÅ
procedure OpenListsInProject(AListID: Integer; AListName: string);
var
NewTab: TTabSheet;
MenuItem: TMenuItem;
i, j: integer;
//08.09.2011 Buffer: array[0..1023] of Char;
TempPath: string;
ListSettings: TListSettingRecord;
PrjCaption: string;
ListCaption: String;
Addlayer: TLayer;
ListStream: TMemoryStream;
fFileName: string;
VirtualCabinetExist: Boolean;
OldTick, CurrTick: Cardinal;
ObjIdx: Integer;
Figure: TFigure;
NeedCheck: Boolean;
isDuplicate: Boolean;
SCSCatalog: TSCSCatalog;
SCSCompon: TSCSComponent;
a: integer;
ListOfUse: TList;
//Tolik
FFigure: Tfigure;
CadFigList: TList; // ñëåïîê ôèãóð Êàäà (Ñïèñîê)
//
begin
try
// ñîçäàòü ëèñò â ïðîåêòå
TF_CAD.Create(FSCS_Main);
GCadForm.FCADListID := AListID;
GCadForm.FCADListName := AListName;
GCadForm.FCADProjectName := GetCurrProjectName;
GCadForm.PCad.DisableAlign; //27.12.2011
GCadForm.PCad.BeginUpdate;
ListOfUse := TList.Create;
try
LoadSettingsForList(AListID, False);
PrjCaption := GetCurrProjectParams.Caption;
ListCaption := GetListParams(GCadForm.FCADListID).Caption;
GCadForm.Caption := PrjCaption + ' - ' + ListCaption;
try
// ïîäíÿòü Stream ñ ëèñòà
ListStream := OpenListInPM(GCadForm.FCADListID, GCadForm.FCADListName, fFileName);
if (ListStream <> nil) or (fFileName <> '') then
begin
//27.12.2010 - Ïåðåä ïîäíÿòèåì îáúåêòîâ LoadFromFile î÷èñòèò âñå, ïîýòîìó íóæíî FActiveNet ñáðîñèòü
if ActiveNet = GCadForm.FActiveNet then
ActiveNet := nil;
GCadForm.FActiveNet := nil;
if ListStream <> nil then
begin
TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
ListStream.SaveToFile(TempPath + 'tempCAD.pwd');
// ïîäãðóçèòü èç ôàéëà
GCadForm.PCad.OnObjectInserted := nil;
GCadForm.PCad.LoadFromFile(TempPath + 'tempCAD.pwd');
GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted;
end
else
if fFileName <> '' then
begin
// ïîäãðóçèòü èç ôàéëà
GCadForm.PCad.OnObjectInserted := nil;
//GProcCnt := 0;
OldTick := GetTickCount;
GCadForm.PCad.LoadFromFile(fFileName);
CurrTick := GetTickCount - OldTick;
GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted;
end;
end;
if (ListStream <> nil) or (fFileName <> '') then
begin
// äëÿ ñòàðûõ ïðîåêòîâ - ïåðåñîçäàòü ñëîè
if GCadForm.PCad.LayerCount = 7 then
begin
AddLayer := TLayer.Create(cCad_Mes7);
GCadForm.PCad.Layers.Add(Addlayer);
end;
if GCadForm.PCad.LayerCount = 8 then
begin
AddLayer := TLayer.create(cCad_Mes8);
GCadForm.PCad.Layers.Add(AddLayer);
GCadForm.FActiveNet := nil;
end;
RaiseActiveNet(GCadForm);
if GCadForm.PCad.LayerCount = 9 then
begin
AddLayer := TLayer.create(cCad_Mes29);
GCadForm.PCad.Layers.Add(AddLayer);
end;
{//17.11.2011
GCadForm.FFrameProjectName := nil;
GCadForm.FFrameListName := nil;
GCadForm.FFrameCodeName := nil;
GCadForm.FFrameIndexName := nil;}
GCadForm.ClearFrameFigures;
GNeedReRaiseProperties := False;
VirtualCabinetExist := False;
// 31.07.2015
// Tolik
// êîïèÿ áëîêà ñì. íèæå
// äëÿ òîãî, ÷òîáû íå "ïëûë" ñïèñîê ôèãóð Êàäà, êîòîðûé áóäåì ïåðåáèðàòü è îáðàáàòûâàòü,
// çäåñü ñîçäàäèì ñëåïîê ôèãóð Êàäà è áóäåì ëàçèòü ïî íåìó, à ñ Êàäîì ñäåëàåì, ÷òî çàõîòèì
// è íè÷åãî íàì íå ïîìåøàåò, è ñäåëàåì âñå â îäèí ïðîõîä (à íå â äâà)
// ÁÓÄÅÒ ÀÊÒÓÀËÜÍÎ, ÑÊÎÐÅÅ ÂÑÅÃÎ, ÄËß ÁÈÒÛÕ ÏÐÎÅÊÒÎÂ !!!
CadFigList := TList.Create; // ñîçäàåì ïóñòîé ñïèñîê
for i := 0 to GCadForm.PCad.FigureCount - 1 do // òóëèì â íåãî âñå ôèãóðû Êàäà êàê åñòü
begin
CadFigList.Add(TFigure(GCadForm.PCad.Figures.Items[i]));
end;
for i := 0 to CadFigList.Count - 1 do
begin
Figure := TFigure(CadFigList[i]);
NeedCheck := False;
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
TConnectorObject(Figure).RaiseProperties(CadFigList);
if TConnectorObject(Figure).FHouse = nil then
begin
//NeedCheck := True;
end
else
begin
{
for j := 0 to Length(TConnectorObject(Figure).FHouse.FApproachesIndexes) - 1 do
begin
if TConnectorObject(GCadForm.PCad.Figures.Items[TConnectorObject(Figure).FHouse.FApproachesIndexes[j]]).ID = Figure.ID then
begin
//NeedCheck := True;
break;
end;
end;
}
if TConnectorObject(Figure).FIsApproach then
begin
if F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferencesList(GCadForm.FCADListID, TConnectorObject(Figure).FComponID) = nil then
begin
SCSCatalog := nil;
if TConnectorObject(Figure).FHouse <> nil then
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CheckCatalogFromReferencesBySCSID(TConnectorObject(Figure).FHouse.ID, GCadForm.FCADListID, isDuplicate);
SCSCompon := nil;
if SCSCatalog <> nil then
SCSCompon := SCSCatalog.GetFirstComponent;
if SCSCompon <> nil then
begin
// âåðíóëñÿ äîì. òåïåðü ïî èíäåêñó èëè ìàðêèðîâêå ïîïðîáóåì íàéòè íóæíûé ÷èëä
for j := 0 to SCSCompon.ChildReferences.Count - 1 do
begin
if ListOfUse.Indexof(TSCSComponent(SCSCompon.ChildReferences[j])) = -1 then
begin
TConnectorObject(Figure).FComponID := TSCSComponent(SCSCompon.ChildReferences[j]).ID;
ListOfUse.Add(TSCSComponent(SCSCompon.ChildReferences[j]));
break;
end;
end;
end
else
begin
{TODO}
// óäàëèòü èç âñåõ ìåñò ýòîò ïîäüåçä
// âûñòàâèòü Deleted ïîäúåçäó
// ÍÅ ÏÐÎÂÒÛÊÀÒÜ ×ÒÎ ÈÌÅÍÍÎ Â ÒÎÌ ÌÅÑÒÅ ÍÅËÜÇß óäàëÿòü è ÷òî-òî ÷èñòèòü - òàê êàê ïîêà íå ïðîøëè âñå ôèãóðû ÷åðåç RaiseProperties - íè÷åãî óäàëÿòü íåëüçÿ ñ ÊÀÄà
end;
end;
end;
end;
end
else if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
TOrthoLine(Figure).RaiseProperties(CadFigList);
//NeedCheck := True;
end
else if CheckFigureByClassName(Figure, cTFrame) then
begin
TFrame(Figure).RaiseProperties;
end
else if CheckFigureByClassName(Figure, cTPlanTrace) then
begin
TPlanTrace(Figure).RaiseProperties(CadFigList);
end
else if CheckFigureByClassName(Figure, cTPlanObject) then
begin
TPlanObject(Figure).RaiseProperties(CadFigList);
end
else if CheckFigureByClassName(Figure, cTPlanConnector) then
begin
TPlanConnector(Figure).RaiseProperties(CadFigList);
end
else if CheckFigureByClassName(Figure, cTCabinet) then
begin
TCabinet(Figure).RaiseProperties(CadFigList);
if TCabinet(Figure).FType = ct_Virtual then
VirtualCabinetExist := True;
//else
// NeedCheck := True;
end
else if CheckFigureByClassName(Figure, cTCabinetExt) then
begin
TCabinetExt(Figure).RaiseProperties(CadFigList);
if TCabinetExt(Figure).FType = ct_Virtual then
VirtualCabinetExist := True;
//else
// NeedCheck := True;
end
else if CheckFigureByClassName(Figure, 'TRichText') then
begin
ObjIdx := GCadForm.FFrameObjects.IndexOf(IntToStr(TRichText(Figure).DataID));
if ObjIdx <> -1 then
GCadForm.FFrameObjects.Objects[ObjIdx] := TRichText(Figure);
end
else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then
TSCSFigureGrp(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTHouse) then
begin
THouse(Figure).RaiseProperties(CadFigList);
NeedCheck := True;
end;
if NeedCheck then
begin
isDuplicate := False;
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CheckCatalogFromReferencesBySCSID(Figure.ID, GCadForm.FCADListID, isDuplicate);
if Assigned(SCSCatalog) then
begin
// âñå ãóä - íàéäåí íà òîì ëèñòå ÷òî íóæíî!
// ïðîâåðèì íà äóáëè
if isDuplicate then
begin
// åñòü åùå ñ òàêèì æå ÈÄ íà äðóãèõ ëèñòàõ
// ëîã ÊÐÈÒÈ×ÅÑÊÈÉ, ÷òî ñ òàêèì äàëåå äåëàòü - íóæíî áóäåò äóìàòü
{TODO}
end;
end
else
begin
if isDuplicate then
begin
// íå íàéäåí, íî åñòü äóáëè
// ëîã ÊÐÈÒÈ×ÅÑÊÈÉ, ÷òî ñ òàêèì äàëåå äåëàòü - íóæíî áóäåò äóìàòü
{TODO}
end
else
begin
// íå íàéäåí, âîçìîæíî ñ òàêèì ÈÄ è åñòü - íî íå íà íóæíîì íàì ëèñòå
//ëîã è ôëàã íà óäàëåíèå
Figure.Deleted := True;
{TODO} // â ëîã äîáàâèòü
end;
end;
end;
end;
FreeAndNil(CadFigList);
a := 0;
while a < GCadForm.PCad.FigureCount do
begin
if TFigure(GCadForm.PCad.Figures[a]).Deleted then
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[a]), cTHouse) then
begin
THouse(GCadForm.PCad.Figures[a]).Deleted := False;
THouse(GCadForm.PCad.Figures[a]).Delete;
a := a + 1;
end
else
begin
//Tolik
{ TFigure(GCadForm.PCad.Figures[a]).destroy;
GCadForm.PCad.Figures.Remove(GCadForm.PCad.Figures[a]);}
FFigure := TFigure(GCadForm.PCad.Figures[a]);
GCadForm.PCad.Figures.Remove(GCadForm.PCad.Figures[a]);
FreeAndNil(FFigure);
//
end;
end
else
a := a + 1;
end;
if GNeedReRaiseProperties then
begin
i := 0;
while i < GCadForm.PCad.FigureCount do
begin
Figure := TFigure(GCadForm.PCad.Figures.Items[i]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
TConnectorObject(Figure).ReRaiseProperties;
end;
if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
TOrthoLine(Figure).ReRaiseProperties;
end;
i := i + 1;
end;
end;
(*
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
Figure := TFigure(GCadForm.PCad.Figures.Items[i]);
NeedCheck := False;
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
TConnectorObject(Figure).RaiseProperties;
if TConnectorObject(Figure).FHouse = nil then
begin
//NeedCheck := True;
end
else
begin
{
for j := 0 to Length(TConnectorObject(Figure).FHouse.FApproachesIndexes) - 1 do
begin
if TConnectorObject(GCadForm.PCad.Figures.Items[TConnectorObject(Figure).FHouse.FApproachesIndexes[j]]).ID = Figure.ID then
begin
//NeedCheck := True;
break;
end;
end;
}
if TConnectorObject(Figure).FIsApproach then
begin
if F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferencesList(GCadForm.FCADListID, TConnectorObject(Figure).FComponID) = nil then
begin
SCSCatalog := nil;
if TConnectorObject(Figure).FHouse <> nil then
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CheckCatalogFromReferencesBySCSID(TConnectorObject(Figure).FHouse.ID, GCadForm.FCADListID, isDuplicate);
SCSCompon := nil;
if SCSCatalog <> nil then
SCSCompon := SCSCatalog.GetFirstComponent;
if SCSCompon <> nil then
begin
// âåðíóëñÿ äîì. òåïåðü ïî èíäåêñó èëè ìàðêèðîâêå ïîïðîáóåì íàéòè íóæíûé ÷èëä
for j := 0 to SCSCompon.ChildReferences.Count - 1 do
begin
if ListOfUse.Indexof(TSCSComponent(SCSCompon.ChildReferences[j])) = -1 then
begin
TConnectorObject(Figure).FComponID := TSCSComponent(SCSCompon.ChildReferences[j]).ID;
ListOfUse.Add(TSCSComponent(SCSCompon.ChildReferences[j]));
break;
end;
end;
end
else
begin
{TODO}
// óäàëèòü èç âñåõ ìåñò ýòîò ïîäüåçä
// âûñòàâèòü Deleted ïîäúåçäó
// ÍÅ ÏÐÎÂÒÛÊÀÒÜ ×ÒÎ ÈÌÅÍÍÎ Â ÒÎÌ ÌÅÑÒÅ ÍÅËÜÇß óäàëÿòü è ÷òî-òî ÷èñòèòü - òàê êàê ïîêà íå ïðîøëè âñå ôèãóðû ÷åðåç RaiseProperties - íè÷åãî óäàëÿòü íåëüçÿ ñ ÊÀÄà
end;
end;
end;
end;
end
else if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
TOrthoLine(Figure).RaiseProperties;
//NeedCheck := True;
end
else if CheckFigureByClassName(Figure, cTFrame) then
begin
TFrame(Figure).RaiseProperties;
end
else if CheckFigureByClassName(Figure, cTPlanTrace) then
begin
TPlanTrace(Figure).RaiseProperties;
end
else if CheckFigureByClassName(Figure, cTPlanObject) then
begin
TPlanObject(Figure).RaiseProperties;
end
else if CheckFigureByClassName(Figure, cTPlanConnector) then
begin
TPlanConnector(Figure).RaiseProperties;
end
else if CheckFigureByClassName(Figure, cTCabinet) then
begin
TCabinet(Figure).RaiseProperties;
if TCabinet(Figure).FType = ct_Virtual then
VirtualCabinetExist := True;
//else
// NeedCheck := True;
end
else if CheckFigureByClassName(Figure, cTCabinetExt) then
begin
TCabinetExt(Figure).RaiseProperties;
if TCabinetExt(Figure).FType = ct_Virtual then
VirtualCabinetExist := True;
//else
// NeedCheck := True;
end
else if CheckFigureByClassName(Figure, 'TRichText') then
begin
ObjIdx := GCadForm.FFrameObjects.IndexOf(IntToStr(TRichText(Figure).DataID));
if ObjIdx <> -1 then
GCadForm.FFrameObjects.Objects[ObjIdx] := TRichText(Figure);
end
else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then
TSCSFigureGrp(Figure).RaiseProperties
else if CheckFigureByClassName(Figure, cTHouse) then
begin
THouse(Figure).RaiseProperties;
NeedCheck := True;
end;
if NeedCheck then
begin
isDuplicate := False;
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CheckCatalogFromReferencesBySCSID(Figure.ID, GCadForm.FCADListID, isDuplicate);
if Assigned(SCSCatalog) then
begin
// âñå ãóä - íàéäåí íà òîì ëèñòå ÷òî íóæíî!
// ïðîâåðèì íà äóáëè
if isDuplicate then
begin
// åñòü åùå ñ òàêèì æå ÈÄ íà äðóãèõ ëèñòàõ
// ëîã ÊÐÈÒÈ×ÅÑÊÈÉ, ÷òî ñ òàêèì äàëåå äåëàòü - íóæíî áóäåò äóìàòü
{TODO}
end;
end
else
begin
if isDuplicate then
begin
// íå íàéäåí, íî åñòü äóáëè
// ëîã ÊÐÈÒÈ×ÅÑÊÈÉ, ÷òî ñ òàêèì äàëåå äåëàòü - íóæíî áóäåò äóìàòü
{TODO}
end
else
begin
// íå íàéäåí, âîçìîæíî ñ òàêèì ÈÄ è åñòü - íî íå íà íóæíîì íàì ëèñòå
//ëîã è ôëàã íà óäàëåíèå
Figure.Deleted := True;
{TODO} // â ëîã äîáàâèòü
end;
end;
end;
end;
a := 0;
while a < GCadForm.PCad.FigureCount do
begin
if TFigure(GCadForm.PCad.Figures[a]).Deleted then
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[a]), cTHouse) then
begin
THouse(GCadForm.PCad.Figures[a]).Deleted := False;
THouse(GCadForm.PCad.Figures[a]).Delete;
a := a + 1;
end
else
begin
//Tolik
{ TFigure(GCadForm.PCad.Figures[a]).destroy;
GCadForm.PCad.Figures.Remove(GCadForm.PCad.Figures[a]);}
FFigure := TFigure(GCadForm.PCad.Figures[a]);
GCadForm.PCad.Figures.Remove(GCadForm.PCad.Figures[a]);
FreeAndNil(FFigure);
//
end;
end
else
a := a + 1;
end;
if GNeedReRaiseProperties then
begin
i := 0;
while i < GCadForm.PCad.FigureCount do
begin
Figure := TFigure(GCadForm.PCad.Figures.Items[i]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
TConnectorObject(Figure).ReRaiseProperties;
end;
if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
TOrthoLine(Figure).ReRaiseProperties;
end;
i := i + 1;
end;
end;
*)
GCadForm.SetFrameFigures;
CorrectStampView;
if not VirtualCabinetExist then
CreateVirtualCabinetInCAD(GCadForm);
SetVisibleCabinetsNumbers(GCadForm.FShowCabinetsNumbers);
SetVisibleCabinetsBounds(GCadForm.FShowCabinetsBounds);
FindObjectsForConvertClasses;
SetCADFrameParams(GCadForm);
if GListRaiseWithErrors then
begin
ShowLog;
GListRaiseWithErrors := False;
end;
end;
except
on E: Exception do addExceptionToLogEx(cCommon_Mes9 + GCadForm.FCADListName + IntToStr(GCadForm.FCADListIndex) + cCommon_Mes10, E.Message);
end;
if ListStream <> nil then
FreeAndNil(ListStream);
if GCadForm.FListType = lt_Normal then
{$IF Defined(ES_GRAPH_SC)}
GCadForm.CurrentLayer := 8;
{$else}
GCadForm.CurrentLayer := 2;
{$ifend}
if GCadForm.FListType = lt_DesignBox then
GCadForm.CurrentLayer := 1;
if GCadForm.FListType = lt_ProjectPlan then
GCadForm.CurrentLayer := 1;
if GCadForm.PCad.ZoomScale < 50 then
GCadForm.SetZoomScale(50);
// Äîáàâèòü ïåðåêëþ÷àòåëü â ïàíåëü ëèñòîâ ïðîåêòà
FSCS_Main.pageCADList.DisableAlign;
try
NewTab := TTabSheet.Create(nil);
NewTab.PageControl := FSCS_Main.pageCADList;
NewTab.Tag := GCadForm.Handle;
NewTab.Caption := ListCaption;
FSCS_Main.pageCADList.ActivePage := NewTab;
finally
FSCS_Main.pageCADList.EnableAlign;
end;
// Äîáàâèòü Ëèñòû â ãëàâíîå ìåíþ
for i := 0 to FSCS_Main.mainWindow.Count - 1 do
if FSCS_Main.mainWindow.Items[i].Caption = '-' then
break;
j := 0;
inc(i);
while FSCS_Main.mainWindow.Count > i do
begin
MenuItem := FSCS_Main.mainWindow.Items[FSCS_Main.mainWindow.Count - 1];
FSCS_Main.mainWindow.Delete(FSCS_Main.mainWindow.Count - 1);
MenuItem.Free;
end;
for j := 0 to FSCS_Main.pageCADList.PageCount - 1 do
begin
MenuItem := TMenuItem.Create(nil);
MenuItem.Caption := FSCS_Main.pageCADList.Pages[j].Caption;
MenuItem.Tag := FSCS_Main.pageCADList.Pages[j].Tag;
MenuItem.AutoCheck := True;
MenuItem.RadioItem := True;
MenuItem.Checked := FSCS_Main.pageCADList.Pages[j] = FSCS_Main.pageCADList.ActivePage;
MenuItem.OnClick := FSCS_Main.SwitchWindow;
FSCS_Main.mainWindow.Add(MenuItem);
end;
finally
ListOfUse.Free;
GCadForm.PCad.EndUpdate;
GCadForm.PCad.EnableAlign; //27.12.2011
end;
except
on E: Exception do addExceptionToLogEx('U_Common.OpenListsInProject', E.Message);
end;
end;
function CreateListDuplicate(AListParams: TListParams; AListStream: TMemoryStream; AFileName: string = ''; aCopySCSFigures: Boolean=true): TF_CAD;
var
NewTab: TTabSheet;
MenuItem: TMenuItem;
i, j: integer;
//08.09.2011 Buffer: array[0..1023] of Char;
TempPath: string;
ListSettings: TListSettingRecord;
PrjCaption: string;
ListCaption: String;
Addlayer: TLayer;
ListStream: TMemoryStream;
Conn: TConnectorObject;
SCSFigureGrp: TSCSFigureGrp;
ObjIdx: Integer;
Figure: TFigure;
ListToDel: TList;
//Tolik
CadFigList: TList;
//
begin
Result := nil;
BeginProgress;
try
TF_CAD.Create(FSCS_Main);
Result := GCadForm; //07.11.2011
if Result.WindowState <> wsMaximized then
Result.WindowState := wsMaximized;
try
//GCadForm.LockSCSFigures; //07.11.2011
GCadForm.FCADListID := AListParams.ID;
GCadForm.FCADListName := AListParams.Name;
GCadForm.FCADProjectName := GetCurrProjectName;
LoadSettingsForList(GCadForm.FCADListID, False);
//EndProgress; Exit; ///// EXIT /////
PrjCaption := GetCurrProjectParams.Caption;
ListCaption := GetListParams(GCadForm.FCADListID).Caption;
GCadForm.Caption := PrjCaption + ' - ' + ListCaption;
GCadForm.PCad.BeginUpdate; //01.07.2013
try
if AListStream <> nil then
begin
TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
AListStream.SaveToFile(TempPath + 'tempCAD.pwd');
// ïîäãðóçèòü èç ôàéëà
GCadForm.PCad.OnObjectInserted := nil;
GCadForm.PCad.LoadFromFile(TempPath + 'tempCAD.pwd');
GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted;
end
else
if AFileName <> '' then
begin
// ïîäãðóçèòü èç ôàéëà
GCadForm.PCad.OnObjectInserted := nil;
GCadForm.PCad.LoadFromFile(AFileName);
GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted;
end;
CorrectStampView; //01.07.2013 - ÷òîáû îáúåêòàì ðàìêè óñòàíîâèòü ïðàâèëüíîå çíà÷åíèå ñâîéñòâà Visible
finally
GCadForm.PCad.EndUpdate; //01.07.2013
end;
//EndProgress;
//Exit; ///// EXIT /////
if (AListStream <> nil) or (AFileName <> '') then
begin
RaiseActiveNet(GCadForm);
{//17.11.2011
GCadForm.FFrameProjectName := nil;
GCadForm.FFrameListName := nil;
GCadForm.FFrameCodeName := nil;
GCadForm.FFrameIndexName := nil;
GCadForm.FFrameStampDeveloper := nil;
GCadForm.FFrameStampChecker := nil;}
GCadForm.ClearFrameFigures;
GNeedReRaiseProperties := False;
//Tolik
CadFigList := TList.Create;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
CadFigList.Add(TFigure(GCadForm.PCad.Figures.Items[i]));
(* for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTConnectorObject) then
begin
if TConnectorObject(GCadForm.PCad.Figures.Items[i]).AsEndPoint then
TConnectorObject(GCadForm.PCad.Figures.Items[i]).AsEndPoint := False;
TConnectorObject(GCadForm.PCad.Figures.Items[i]).RaiseProperties;
end;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTOrthoLine) then
TOrthoLine(GCadForm.PCad.Figures.Items[i]).RaiseProperties;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTFrame) then
TFrame(GCadForm.PCad.Figures.Items[i]).RaiseProperties;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTPlanTrace) then
TPlanTrace(GCadForm.PCad.Figures.Items[i]).RaiseProperties;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTPlanObject) then
TPlanObject(GCadForm.PCad.Figures.Items[i]).RaiseProperties;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTPlanConnector) then
TPlanConnector(GCadForm.PCad.Figures.Items[i]).RaiseProperties;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTCabinet) then
TCabinet(GCadForm.PCad.Figures.Items[i]).RaiseProperties;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTCabinetExt) then
TCabinetExt(GCadForm.PCad.Figures.Items[i]).RaiseProperties;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTHouse) then
THouse(GCadForm.PCad.Figures.Items[i]).RaiseProperties;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), 'TRichText') then
begin
{//17.11.2011
if TRichText(GCadForm.PCad.Figures.Items[i]).DataID = 100 then
GCadForm.FFrameProjectName := TRichText(GCadForm.PCad.Figures.Items[i]);
if TRichText(GCadForm.PCad.Figures.Items[i]).DataID = 200 then
GCadForm.FFrameListName := TRichText(GCadForm.PCad.Figures.Items[i]);
if TRichText(GCadForm.PCad.Figures.Items[i]).DataID = 300 then
GCadForm.FFrameCodeName := TRichText(GCadForm.PCad.Figures.Items[i]);
if TRichText(GCadForm.PCad.Figures.Items[i]).DataID = 400 then
GCadForm.FFrameIndexName := TRichText(GCadForm.PCad.Figures.Items[i]);}
ObjIdx := GCadForm.FFrameObjects.IndexOf(IntToStr(TRichText(GCadForm.PCad.Figures.Items[i]).DataID));
if ObjIdx <> -1 then
GCadForm.FFrameObjects.Objects[ObjIdx] := TRichText(GCadForm.PCad.Figures.Items[i]);
end;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTSCSFigureGrp) then
begin
SCSFigureGrp := TSCSFigureGrp(GCadForm.PCad.Figures.Items[i]);
for j := 0 to SCSFigureGrp.InFigures.Count - 1 do
begin
if CheckFigureByClassName(TFigure(SCSFigureGrp.InFigures[j]), cTConnectorObject) then
if TConnectorObject(SCSFigureGrp.InFigures[j]).AsEndPoint then
TConnectorObject(SCSFigureGrp.InFigures[j]).AsEndPoint := False;
end;
TSCSFigureGrp(GCadForm.PCad.Figures.Items[i]).RaiseProperties;
end;
end;*)
for i := 0 to CadFigList.Count - 1 do
begin
if CheckFigureByClassName(TFigure(CadFigList[i]), cTConnectorObject) then
begin
if TConnectorObject(CadFigList[i]).AsEndPoint then
TConnectorObject(CadFigList[i]).AsEndPoint := False;
TConnectorObject(CadFigList[i]).RaiseProperties(CadFigList);
end;
if CheckFigureByClassName(TFigure(CadFigList[i]), cTOrthoLine) then
TOrthoLine(CadFigList[i]).RaiseProperties(CadFigList);
if CheckFigureByClassName(TFigure(CadFigList[i]), cTFrame) then
TFrame(CadFigList[i]).RaiseProperties;
if CheckFigureByClassName(TFigure(CadFigList[i]), cTPlanTrace) then
TPlanTrace(CadFigList[i]).RaiseProperties(CadFigList);
if CheckFigureByClassName(TFigure(CadFigList[i]), cTPlanObject) then
TPlanObject(CadFigList[i]).RaiseProperties(CadFigList);
if CheckFigureByClassName(TFigure(CadFigList[i]), cTPlanConnector) then
TPlanConnector(CadFigList[i]).RaiseProperties(CadFigList);
if CheckFigureByClassName(TFigure(CadFigList[i]), cTCabinet) then
TCabinet(CadFigList[i]).RaiseProperties(CadFigList);
if CheckFigureByClassName(TFigure(CadFigList[i]), cTCabinetExt) then
TCabinetExt(CadFigList[i]).RaiseProperties(CadFigList);
if CheckFigureByClassName(TFigure(CadFigList[i]), cTHouse) then
THouse(CadFigList[i]).RaiseProperties(CadFigList);
if CheckFigureByClassName(TFigure(CadFigList[i]), 'TRichText') then
begin
ObjIdx := GCadForm.FFrameObjects.IndexOf(IntToStr(TRichText(CadFigList[i]).DataID));
if ObjIdx <> -1 then
GCadForm.FFrameObjects.Objects[ObjIdx] := TRichText(CadFigList[i]);
end;
if CheckFigureByClassName(TFigure(CadFigList[i]), cTSCSFigureGrp) then
begin
SCSFigureGrp := TSCSFigureGrp(CadFigList[i]);
for j := 0 to SCSFigureGrp.InFigures.Count - 1 do
begin
if CheckFigureByClassName(TFigure(SCSFigureGrp.InFigures[j]), cTConnectorObject) then
if TConnectorObject(SCSFigureGrp.InFigures[j]).AsEndPoint then
TConnectorObject(SCSFigureGrp.InFigures[j]).AsEndPoint := False;
end;
TSCSFigureGrp(CadFigList[i]).RaiseProperties(CadFigList);
end;
end;
{
if GNeedReRaiseProperties then
begin
i := 0;
while i < GCadForm.PCad.FigureCount do
begin
Figure := TFigure(GCadForm.PCad.Figures.Items[i]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
TConnectorObject(Figure).ReRaiseProperties;
end;
if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
TOrthoLine(Figure).ReRaiseProperties;
end;
i := i + 1;
end;
end;}
// Tolik
FreeAndNil(CadFigList);
//
GCadForm.SetFrameFigures;
SetVisibleCabinetsNumbers(GCadForm.FShowCabinetsNumbers);
SetVisibleCabinetsBounds(GCadForm.FShowCabinetsBounds);
FindObjectsForConvertClasses;
SetCADFrameParams(GCadForm);
if GListRaiseWithErrors then
begin
ShowLog;
GListRaiseWithErrors := False;
end;
//18.06.2013 - Óäàëÿåì ÑÊÑ îáúåêòû, åñëè ôëàã ñáðîøåí
if Not aCopySCSFigures then
begin
try
ListToDel := TList.Create;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
Figure := TFigure(GCadForm.PCad.Figures.Items[i]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
TConnectorObject(Figure).ID := 0;
ListToDel.Add(Figure);
end
else if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
TOrthoLine(Figure).ID := 0;
ListToDel.Add(Figure);
end
else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then
begin
SCSFigureGrp := TSCSFigureGrp(Figure);
ListToDel.Add(Figure);
end;
end;
if ListToDel.Count > 0 then
begin
for i := ListToDel.Count - 1 downto 0 do
begin
Figure := TFigure(ListToDel[i]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
TConnectorObject(Figure).Delete
else if CheckFigureByClassName(Figure, cTOrthoLine) then
TOrthoLine(Figure).Delete
else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then
TSCSFigureGrp(Figure).Delete;
end;
RefreshCAD(GCadForm.PCad);
end;
FreeAndNil(ListToDel);
except
on E: Exception do AddExceptionToLogExt('U_Common', 'CopyList:removeSCSObjects', E.Message);
end;
end;
end;
if AListStream <> nil then
FreeAndNil(ListStream);
FSCS_Main.aSetSCSLayer.Execute;
// Äîáàâèòü ïåðåêëþ÷àòåëü â ïàíåëü ëèñòîâ ïðîåêòà
NewTab := TTabSheet.Create(nil);
NewTab.PageControl := FSCS_Main.pageCADList;
NewTab.Tag := GCadForm.Handle;
NewTab.Caption := ListCaption;
FSCS_Main.pageCADList.ActivePage := NewTab;
// Äîáàâèòü Ëèñòû â ãëàâíîå ìåíþ
for i := 0 to FSCS_Main.mainWindow.Count - 1 do
if FSCS_Main.mainWindow.Items[i].Caption = '-' then
break;
j := 0;
inc(i);
while FSCS_Main.mainWindow.Count > i do
begin
MenuItem := FSCS_Main.mainWindow.Items[FSCS_Main.mainWindow.Count - 1];
FSCS_Main.mainWindow.Delete(FSCS_Main.mainWindow.Count - 1);
MenuItem.Free;
end;
for j := 0 to FSCS_Main.pageCADList.PageCount - 1 do
begin
MenuItem := TMenuItem.Create(nil);
MenuItem.Caption := FSCS_Main.pageCADList.Pages[j].Caption;
MenuItem.Tag := FSCS_Main.pageCADList.Pages[j].Tag;
MenuItem.AutoCheck := True;
MenuItem.RadioItem := True;
MenuItem.Checked := FSCS_Main.pageCADList.Pages[j] = FSCS_Main.pageCADList.ActivePage;
MenuItem.OnClick := FSCS_Main.SwitchWindow;
FSCS_Main.mainWindow.Add(MenuItem);
end;
if GCadForm.FListType = lt_Normal then
begin
EnableOptionsForNormalList;
end
else
if GCadForm.FListType = lt_DesignBox then
begin
DisableOptionsForDesignList;
end
else
if GCadForm.FListType = lt_ProjectPlan then
begin
DisableOptionsForDesignList;
end;
// SkipAllLinesShadows(GCadForm);
// óñòàíîâèòü ïàðàìåòðû ëèñòà îò ìàñòåðà ñîçäàíèÿ ëèñòà
// LoadSettingsForListByParams(AListParams);
// SaveListParams(GCadForm.FCADListID, AListParams);
finally
//GCadForm.UnLockSCSFigures; //07.11.2011
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CreateListDuplicate', E.Message);
end;
EndProgress;
end;
procedure SetNewListParams(aCADParams: TCADParams);
var
i: integer;
val: double;
ScaleAs: double;
ScaleAll: double;
KoefAs: double;
KoefAll: double;
PageKoef: double;
GetConnHeight: Double;
GetLineHeight: Double;
PrjCaption: string;
ListCaption: string;
valInteger: Integer;
valDouble: double;
begin
try
// ËÈÍÅÉÊÀ
ScaleAs := 0;
ScaleAll := 0;
KoefAs := 0;
KoefAll := 0;
PageKoef := 0;
//21.09.2010
// // ÌÅÒÐÈ×ÅÑÊÀß
// if F_MasterNewList.gbRulerModeMetric.Visible then
// begin
// // äëÿ ïîêàçà îòäåëüíîãî îòðåçêà íà ýêðàíå
// if F_MasterNewList.rbm1.Checked then
// KoefAs := 100;
// if F_MasterNewList.rbsm1.Checked then
// KoefAs := 1;
// if F_MasterNewList.rbmm1.Checked then
// KoefAs := 0.1;
// if (F_MasterNewList.rbm1.Checked) Or (F_MasterNewList.rbsm1.Checked) Or (F_MasterNewList.rbmm1.Checked) then
// begin
// if F_MasterNewList.edSizeAsMetric.Text <> '' then
// begin
// ScaleAs := StrToFloat_My(F_MasterNewList.edSizeAsMetric.Text) * KoefAs;
// valDouble := ScaleAs;
// if aCADParams.CADMapScale <> valDouble then
// begin
// GCadForm.PCad.MapScale := valDouble;
// ReScaleAllDimLines;
// end;
// end;
// end;
// // äëÿ îòîáðàæåíèÿ îáùåé äëèííû íà ñòðàíèöå
// if F_MasterNewList.rbm2.Checked then
// KoefAll := 1;
// if F_MasterNewList.rbsm2.Checked then
// KoefAll := 100;
// if F_MasterNewList.rbmm2.Checked then
// KoefAll := 1000;
// if (F_MasterNewList.rbm2.Checked) Or (F_MasterNewList.rbsm2.Checked) Or (F_MasterNewList.rbmm2.Checked) then
// begin
// if F_MasterNewList.edSizeAllMetric.Text <> '' then
// begin
// PageKoef := GCadForm.PCad.WorkWidth / 1000;
// ScaleAll := StrToFloat_My(F_MasterNewList.edSizeAllMetric.Text) / PageKoef / KoefAll;
// valDouble := ScaleAll;
// if aCADParams.CADMapScale <> valDouble then
// begin
// GCadForm.PCad.MapScale := valDouble;
// ReScaleAllDimLines;
// end;
// end;
// end;
// end
// else
// // ÄÞÉÌÎÂÀß
// if F_MasterNewList.gbRulerModeWhitworth.Visible then
// begin
// // äëÿ ïîêàçà îòäåëüíîãî îòðåçêà íà ýêðàíå
// if F_MasterNewList.rbin1.Checked then
// KoefAs := 1;
// if F_MasterNewList.rbft1.Checked then
// KoefAs := 12;
// if (F_MasterNewList.rbin1.Checked) Or (F_MasterNewList.rbft1.Checked) then
// begin
// if F_MasterNewList.edSizeAsWhitworth.Text <> '' then
// begin
// ScaleAs := StrToFloat_My(F_MasterNewList.edSizeAsWhitworth.Text) * KoefAs;
// valDouble := ScaleAs;
// if aCADParams.CADMapScale <> valDouble then
// begin
// GCadForm.PCad.MapScale := valDouble;
// ReScaleAllDimLines;
// end;
// end;
// end;
// // äëÿ îòîáðàæåíèÿ îáùåé äëèííû íà ñòðàíèöå
// if F_MasterNewList.rbin2.Checked then
// KoefAll := 12;
// if F_MasterNewList.rbft2.Checked then
// KoefAll := 1;
// if (F_MasterNewList.rbin2.Checked) Or (F_MasterNewList.rbft2.Checked) then
// begin
// if F_MasterNewList.edSizeAllWhitworth.Text <> '' then
// begin
// PageKoef := GCadForm.PCad.WorkWidth / 304.8 {/ 1000};
// ScaleAll := StrToFloat_My(F_MasterNewList.edSizeAllWhitworth.Text) / PageKoef / KoefAll;
// valDouble := ScaleAll;
// if aCADParams.CADMapScale <> valDouble then
// begin
// GCadForm.PCad.MapScale := valDouble;
// ReScaleAllDimLines;
// end;
// end;
// end;
// end;
//21.09.2010
valDouble := F_MasterNewList.CheckMapScaleResult;
if (aCADParams.CADMapScale <> valDouble) or (GCadForm.PCad.MapScale <> valDouble) then
begin
GCadForm.PCad.MapScale := valDouble;
ReScaleAllDimLines;
end;
// ***
// êîððåêöèÿ øàãà ñåòêè
valDouble := StrToFloat_My(F_MasterNewList.edStepGrid.Text);
if valDouble = 0 then
valDouble := 0.1;
if aCADParams.CADGridStep <> valDouble then
GCadForm.PCad.GridStep := valDouble;
// Ïðîñòî ïðèñâîèòü èìåíà îáúåêòàì ïî ôîðìàòó
SetShowNameTypeInCAD(GCadForm.FShowObjectCaptionsType);
SetShowNameTypeInCAD(GCadForm.FShowObjectNotesType);
UpdateForLayers;
PrjCaption := GetCurrProjectParams.Caption;
ListCaption := GetListParams(GCadForm.FCADListID).Caption;
// ÈÌß ËÈÑÒÀ
if F_MasterNewList.edListName.Text <> '' then
begin
GCadForm.FCADListName := F_MasterNewList.edListName.Text;
GCadForm.FCADProjectName := GetCurrProjectName;
GCadForm.Caption := PrjCaption + ' - ' + ListCaption;
end;
SetNewListNameInPM(GCadForm.FCADListID, GCadForm.FCADListName);
FSCS_Main.pageCADList.ActivePage.Caption := ListCaption;
for i := 0 to FSCS_Main.mainWindow.Count - 1 do
begin
if FSCS_Main.mainWindow.Items[i].Checked then
break;
end;
FSCS_Main.mainWindow.Items[i].Caption := ListCaption;
// òèï îòîáðàæåíèÿ ñåòåé
GCadForm.FShowNetworkTypes := [];
if F_MasterNewList.cbAllNetworks.Checked then
GCadForm.FShowNetworkTypes := [nt_All];
if F_MasterNewList.cbComputerNetwork.Enabled then
if F_MasterNewList.cbComputerNetwork.Checked then
GCadForm.FShowNetworkTypes := GCadForm.FShowNetworkTypes + [nt_Computer];
if F_MasterNewList.cbTelephonNetwork.Enabled then
if F_MasterNewList.cbTelephonNetwork.Checked then
GCadForm.FShowNetworkTypes := GCadForm.FShowNetworkTypes + [nt_Telephon];
if F_MasterNewList.cbElectricNetwork.Enabled then
if F_MasterNewList.cbElectricNetwork.Checked then
GCadForm.FShowNetworkTypes := GCadForm.FShowNetworkTypes + [nt_Electric];
if F_MasterNewList.cbTelevisionNetwork.Enabled then
if F_MasterNewList.cbTelevisionNetwork.Checked then
GCadForm.FShowNetworkTypes := GCadForm.FShowNetworkTypes + [nt_Television];
if F_MasterNewList.cbGasNetwork.Enabled then
if F_MasterNewList.cbGasNetwork.Checked then
GCadForm.FShowNetworkTypes := GCadForm.FShowNetworkTypes + [nt_Gas];
// òèï óãîëêà
if F_MasterNewList.rbCornerNone.Checked then
GCadForm.FDefaultCornerType := crn_None;
if F_MasterNewList.rbCornerOut.Checked then
GCadForm.FDefaultCornerType := crn_Out;
if F_MasterNewList.rbCornerIn.Checked then
GCadForm.FDefaultCornerType := crn_In;
if F_MasterNewList.rbCornerVertical.Checked then
GCadForm.FDefaultCornerType := crn_Vertical;
if F_MasterNewList.rbCornerAdapter.Checked then
GCadForm.FDefaultCornerType := crn_Adapter;
GCadForm.FKeepLineTypesRules := F_MasterNewList.cbKeepLineTypesRules.Checked;
SetDimLinesType(GCadForm.FDimLinesType);
SetVisibleCabinetsNumbers(GCadForm.FShowCabinetsNumbers);
SetVisibleCabinetsBounds(GCadForm.FShowCabinetsBounds);
// òèï ïîäïèñè ê òðàññå
if aCADParams.CADLinesCaptions <> GCadForm.FShowLineCaptionsType then
begin
if GCadForm.FShowLineCaptionsType = skExternalSCS then
SetAllTracesUserLength
else
SetAllTracesAutoLength;
end;
// ïðîâåðèòü âñå êàáèíåòû, ïåðåóñòàíîâèòü âûñîòû ôàëüø-ïîòîëêîì åñëè íóæíî
// ïåðåïðîâåðèòü âñå ìåæýòàæíûå ïîäúåìû, ïîñëå èçìåíåíèÿ âûñîòû ýòàæà
if aCADParams.CADHeightRoom <> GCadForm.FRoomHeight then
begin
CheckAllCabinetsFalseFloorHeights;
SetAllBetweenFloorRaises;
end;
// ïðèìåíèòü íàñòðîéêè äëÿ âñåõ îáúåêòîâ
if F_MasterNewList.cbApplyForAllSCSObjects.Checked then
begin
GetConnHeight := UOMToMetre(StrToFloat_My(F_MasterNewList.edConnTotal.Text));
GetLineHeight := UOMToMetre(StrToFloat_My(F_MasterNewList.edLineTotal.Text));
ApplyParamsForAllSCSObject(GetConnHeight, GetLineHeight, GCadForm.FShowObjectCaptionsType, GCadForm.FShowObjectNotesType, GCadForm.FShowLineCaptionsType, GCadForm.FShowLineNotesType, aCADParams);
ApplyCornerTypeForConnectors(GCadForm.FDefaultCornerType);
ApplyCaptionNotesParams(aCADParams);
end;
// îáíîâèòü ñêðîëëû
GCadForm.ChangeScrollsOnChangeListSize;
// îáíîâèòü íàâèãàòîð
ReAssignNavigatorParams;
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
RefreshCAD(GCadForm.PCad);
end;
except
ShowMessage(cCommon_Mes11);
F_MasterNewList.ModalResult := mrNone;
end;
end;
procedure SetNewListParamsForMaster(aCADParams: TCADParams);
var
i: integer;
val: double;
ScaleAs: double;
ScaleAll: double;
KoefAs: double;
KoefAll: double;
PageKoef: double;
GetConnHeight: Double;
GetLineHeight: Double;
PrjCaption: string;
ListCaption: string;
valInteger: Integer;
valDouble: double;
FName: string;
begin
try
// ËÈÍÅÉÊÀ
ScaleAs := 0;
ScaleAll := 0;
KoefAs := 0;
KoefAll := 0;
PageKoef := 0;
//21.09.2010
// // ÌÅÒÐÈ×ÅÑÊÀß
// if F_MasterNewListLite.gbRulerModeMetric.Visible then
// begin
// // äëÿ ïîêàçà îòäåëüíîãî îòðåçêà íà ýêðàíå
// if F_MasterNewListLite.rbm1.Checked then
// KoefAs := 100;
// if F_MasterNewListLite.rbsm1.Checked then
// KoefAs := 1;
// if F_MasterNewListLite.rbmm1.Checked then
// KoefAs := 0.1;
// if (F_MasterNewListLite.rbm1.Checked) Or (F_MasterNewListLite.rbsm1.Checked) Or (F_MasterNewListLite.rbmm1.Checked) then
// begin
// if F_MasterNewListLite.edSizeAsMetric.Text <> '' then
// begin
// ScaleAs := StrToFloat_My(F_MasterNewListLite.edSizeAsMetric.Text) * KoefAs;
// valDouble := ScaleAs;
// if aCADParams.CADMapScale <> valDouble then
// begin
// GCadForm.PCad.MapScale := valDouble;
// ReScaleAllDimLines;
// end;
// end;
// end;
// // äëÿ îòîáðàæåíèÿ îáùåé äëèííû íà ñòðàíèöå
// if F_MasterNewListLite.rbm2.Checked then
// KoefAll := 1;
// if F_MasterNewListLite.rbsm2.Checked then
// KoefAll := 100;
// if F_MasterNewListLite.rbmm2.Checked then
// KoefAll := 1000;
// if (F_MasterNewListLite.rbm2.Checked) Or (F_MasterNewListLite.rbsm2.Checked) Or (F_MasterNewListLite.rbmm2.Checked) then
// begin
// if F_MasterNewListLite.edSizeAllMetric.Text <> '' then
// begin
// PageKoef := GCadForm.PCad.WorkWidth / 1000;
// ScaleAll := StrToFloat_My(F_MasterNewListLite.edSizeAllMetric.Text) / PageKoef / KoefAll;
// valDouble := ScaleAll;
// if aCADParams.CADMapScale <> valDouble then
// begin
// GCadForm.PCad.MapScale := valDouble;
// ReScaleAllDimLines;
// end;
// end;
// end;
// end
// else
// // ÄÞÉÌÎÂÀß
// if F_MasterNewListLite.gbRulerModeWhitworth.Visible then
// begin
// // äëÿ ïîêàçà îòäåëüíîãî îòðåçêà íà ýêðàíå
// if F_MasterNewListLite.rbin1.Checked then
// KoefAs := 1;
// if F_MasterNewListLite.rbft1.Checked then
// KoefAs := 12;
// if (F_MasterNewListLite.rbin1.Checked) Or (F_MasterNewListLite.rbft1.Checked) then
// begin
// if F_MasterNewListLite.edSizeAsWhitworth.Text <> '' then
// begin
// ScaleAs := StrToFloat_My(F_MasterNewListLite.edSizeAsWhitworth.Text) * KoefAs;
// valDouble := ScaleAs;
// if aCADParams.CADMapScale <> valDouble then
// begin
// GCadForm.PCad.MapScale := valDouble;
// ReScaleAllDimLines;
// end;
// end;
// end;
// // äëÿ îòîáðàæåíèÿ îáùåé äëèííû íà ñòðàíèöå
// if F_MasterNewListLite.rbin2.Checked then
// KoefAll := 12;
// if F_MasterNewListLite.rbft2.Checked then
// KoefAll := 1;
// if (F_MasterNewListLite.rbin2.Checked) Or (F_MasterNewListLite.rbft2.Checked) then
// begin
// if F_MasterNewListLite.edSizeAllWhitworth.Text <> '' then
// begin
// PageKoef := GCadForm.PCad.WorkWidth / 304.8 {/ 1000};
// ScaleAll := StrToFloat_My(F_MasterNewListLite.edSizeAllWhitworth.Text) / PageKoef / KoefAll;
// valDouble := ScaleAll;
// if aCADParams.CADMapScale <> valDouble then
// begin
// GCadForm.PCad.MapScale := valDouble;
// ReScaleAllDimLines;
// end;
// end;
// end;
//
// end;
//21.09.2010
valDouble := F_MasterNewListLite.CheckMapScaleResult;
if (aCADParams.CADMapScale <> valDouble) or (GCadForm.PCad.MapScale <> valDouble) then
begin
GCadForm.PCad.MapScale := valDouble;
ReScaleAllDimLines;
end;
// ***
PrjCaption := GetCurrProjectParams.Caption;
ListCaption := GetListParams(GCadForm.FCADListID).Caption;
// ÈÌß ËÈÑÒÀ
if F_MasterNewList.edListName.Text <> '' then
begin
GCadForm.FCADListName := F_MasterNewList.edListName.Text;
GCadForm.FCADProjectName := GetCurrProjectName;
GCadForm.Caption := PrjCaption + ' - ' + ListCaption;
end;
SetNewListNameInPM(GCadForm.FCADListID, GCadForm.FCADListName);
FSCS_Main.pageCADList.ActivePage.Caption := ListCaption;
for i := 0 to FSCS_Main.mainWindow.Count - 1 do
begin
if FSCS_Main.mainWindow.Items[i].Checked then
break;
end;
FSCS_Main.mainWindow.Items[i].Caption := ListCaption;
if (F_MasterNewListLite.edSubPath.Text <> '') and (FileExists(F_MasterNewListLite.edSubPath.Text)) then
begin
FName := F_MasterNewListLite.edSubPath.Text;
LoadSubWithMaster(FName);
end;
// îáíîâèòü ñêðîëëû
GCadForm.ChangeScrollsOnChangeListSize;
// îáíîâèòü íàâèãàòîð
ReAssignNavigatorParams;
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
RefreshCAD(GCadForm.PCad);
except
ShowMessage(cCommon_Mes11);
F_MasterNewList.ModalResult := mrNone;
end;
end;
procedure ApplyCaptionNotesParams(aCADParams: TCADParams);
var
i, j: Integer;
CurrLine: TOrthoLine;
CurrConn: TConnectorObject;
valBool: Boolean;
isApply: Boolean;
begin
try
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
// Conns
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then
begin
CurrConn := TConnectorObject(GCadForm.PCad.Figures[i]);
// Selected
if not F_MasterNewList.cbApplyForSelectedOnly.Checked then
isApply := True
else
begin
if CurrConn.Selected then
isApply := True
else
isApply := False;
end;
//
if isApply then
begin
if CurrConn.ConnectorType <> ct_Clear then
begin
// ÏÐÈÌÅÍÈÒÜ
if TCheckBoxState(F_MasterNewList.cbShowConnectorsCaptions.State) <> cbGrayed then
begin
valBool := F_MasterNewList.cbShowConnectorsCaptions.Checked;
CurrConn.ShowCaptions := F_MasterNewList.cbShowConnectorsCaptions.Checked; //26.05.2011
if aCADParams.CADShowConnObjectCaption <> valBool then
begin
//26.05.2011 if F_MasterNewList.cbShowConnectorsCaptions.Checked then
//26.05.2011 CurrConn.ShowCaptions := True
//26.05.2011 else
//26.05.2011 CurrConn.ShowCaptions := False;
CurrConn.ReCreateCaptionsGroup(false, true);
end;
end;
if TCheckBoxState(F_MasterNewList.cbShowConnectorsNotes.State) <> cbGrayed then
begin
valBool := F_MasterNewList.cbShowConnectorsNotes.Checked;
CurrConn.ShowNotes := F_MasterNewList.cbShowConnectorsNotes.Checked; //26.05.2011
if aCADParams.CADShowConnObjectNote <> valBool then
begin
//26.05.2011 if F_MasterNewList.cbShowConnectorsNotes.Checked then
//26.05.2011 CurrConn.ShowNotes := True
//26.05.2011 else
//26.05.2011 CurrConn.ShowNotes := False;
CurrConn.ReCreateNotesGroup;
end;
end;
end;
end;
end;
// Lines
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then
begin
CurrLine := TOrthoLine(GCadForm.PCad.Figures[i]);
// Selected
if not F_MasterNewList.cbApplyForSelectedOnly.Checked then
isApply := True
else
begin
if CurrLine.Selected then
isApply := True
else
isApply := False;
end;
//
if isApply then
begin
if not CurrLine.FIsRaiseUpDown then
begin
// ÏÐÈÌÅÍÈÒÜ
if TCheckBoxState(F_MasterNewList.cbShowLinesCaptions.State) <> cbGrayed then
begin
valBool := F_MasterNewList.cbShowLinesCaptions.Checked;
CurrLine.ShowCaptions := F_MasterNewList.cbShowLinesCaptions.Checked; //26.05.2011
if aCADParams.CADShowLineObjectCaption <> valBool then
begin
//26.05.2011if F_MasterNewList.cbShowLinesCaptions.Checked then
//26.05.2011 CurrLine.ShowCaptions := True
//26.05.2011else
//26.05.2011 CurrLine.ShowCaptions := False;
CurrLine.ReCreateCaptionsGroup(false, true);
end;
end;
if F_MasterNewList.cbShowLinesLength.Enabled and (TCheckBoxState(F_MasterNewList.cbShowLinesLength.State) <> cbGrayed) then
begin
valBool := F_MasterNewList.cbShowLinesLength.Checked;
CurrLine.ShowLength := F_MasterNewList.cbShowLinesLength.Checked; //26.05.2011
if aCADParams.CADShowLineObjectLength <> valBool then
begin
//26.05.2011 if F_MasterNewList.cbShowLinesLength.Checked then
//26.05.2011 CurrLine.ShowLength := True
//26.05.2011 else
//26.05.2011 CurrLine.ShowLength := False;
CurrLine.UpdateLengthTextBox(false, true);
end;
end;
if TCheckBoxState(F_MasterNewList.cbShowLinesNotes.State) <> cbGrayed then
begin
valBool := F_MasterNewList.cbShowLinesNotes.Checked;
CurrLine.ShowNotes := F_MasterNewList.cbShowLinesNotes.Checked; //26.05.2011
if aCADParams.CADShowLineObjectNote <> valBool then
begin
//26.05.2011 if F_MasterNewList.cbShowLinesNotes.Checked then
//26.05.2011 CurrLine.ShowNotes := True
//26.05.2011 else
//26.05.2011 CurrLine.ShowNotes := False;
CurrLine.ReCreateNotesGroup;
end;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ApplyCaptionNotesParams', E.Message);
end;
end;
procedure SetTraceLimitStatus(AID_List, AID_Object: Integer; AStatus: Boolean);
var
FFigure: TFigure;
CurrCadForm: TF_CAD;
begin
try
CurrCadForm := GetListByID(AID_List);
if CurrCadForm <> nil then
begin
FFigure := GetFigureByID(CurrCadForm, AID_Object);
if FFigure <> nil then
if CheckFigureByClassName(FFigure, cTOrthoLine) then
TOrthoLine(FFigure).IsLengthAboveLimit := AStatus;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetTraceLimitStatus', E.Message);
end;
end;
procedure CreateDesignList(ABox: TConnectorObject);
var
ListParams: TListParams;
CadFormFromBox: TF_CAD;
begin
try
CadFormFromBox := GCadForm;
ListParams := GetListParamsForNewList;
ListParams.Caption := GetListDesignedName(ABox.ID);
ListParams.Name := ListParams.Caption;
ListParams.MarkID := 0;
ListParams.Settings.ListType := lt_DesignBox;
ListParams.Settings.IDFigureForDesignList := ABox.ID;
ListParams.Settings.IDListForDesignList := GCadForm.FCADListID;
MakeEditList(meMake, ListParams, False);
ABox.FJoinedListIDForBox := GCadForm.FCADListID;
GCadForm.FDesignListShowName := F_ChooseDesignBoxParams.cbShowDesignBoxName.Checked;
GCadForm.FDesignListShowSign := F_ChooseDesignBoxParams.cbShowDesignBoxSign.Checked;
GCadForm.FDesignListShowMark := F_ChooseDesignBoxParams.cbShowDesignBoxMark.Checked;
UpdateDesignList(GCadForm, ABox);
except
on E: Exception do addExceptionToLogEx('U_Common.CreateDesignList', E.Message);
end;
end;
procedure OpenDesignList(ABox: TConnectorObject; AList: TF_CAD);
var
i: integer;
begin
try
AList.BringToFront;
if AList.WindowState <> wsMaximized then
AList.WindowState := wsMaximized;
UpdateDesignList(AList, ABox);
except
on E: Exception do addExceptionToLogEx('U_Common.OpenDesignList', E.Message);
end;
end;
procedure CreateOpenDesignListFromPM(AID_List, AID_Box: Integer);
var
FFigure: TFigure;
FList: TF_CAD;
begin
try
FList := GetListByID(AID_List);
if FList <> nil then
begin
FFigure := GetFigureByID(FList, AID_Box);
if FFigure <> nil then
begin
GPopupFigure := FFigure;
FSCS_Main.aDesignBox.Execute;
end;
end;
except
on E: Exception do addExceptionToLogEx('CreateOpenDesignListFromPM', E.Message);
end;
end;
procedure UpdateDesignList(AList: TF_CAD; ABox: TConnectorObject);
var
i, j: integer;
FileName: string;
TopIndent, LeftIndent: Double;
DesignParams: TComponentDesignParams;
aDescription, aName, aSign, aMark, ServiceStr, str: string;
aWidth: Double;
aHeightM: Double;
aHeightU: Double;
OldBoxHeight, OldBoxWidth: Double;
NewBoxHeight, NewBoxWidth: Double;
BoxHeightKoef, BoxWidthKoef: Double;
SlotsWidth: Double;
RulerHeight: Double;
CadRulerWidth: Double;
CadRulerHeight: Double;
BegDrawPoint: TDoublePoint;
ComponHeight, ComponWidth: Double;
OldComponHeight, OldComponWidth: Double;
ToBoxPoints: TDoublePoint;
ListFormatKoef: Double;
aTopBound, aBottomBound, aLeftBound, aRightBound: Double;
DescrObject: TRichText;
DescrInsObject: TRichText;
DescrPoints: TDoublePoint;
DescrLHandle: Integer;
BlockFig: TBlock;
ComponsList: TObjectList;
aGraphicalImage: TMemoryStream;
TM: TTextMetric;
xCanvas: TMetafileCanvas;
h, w: double;
FigureGrp: TFigureGrp;
ListX: double;
PanelsHeightBefore: Double; //27.04.2011
Koef1, Koef2, PanelsHeight: Double; //27.04.2011
NeedApplayKoef: boolean;
UCount: integer;
StampObject: TFigureGrp;
UpperStampObj: TRectangle;
LHandle: integer;
TextField: TRichText;
begin
try
//Koef1_m := 1.227;
//Koef2_m := 0.186; {0.1135}
Koef1 := 1.01; //1 //0.99;
Koef2 := 0.99; //1;
NewBoxWidth := 0; //#From Oleg# //14.09.2010
ListFormatKoef := 1; //#From Oleg# //14.09.2010
SlotsWidth := 0; //#From Oleg# //14.09.2010
Alist.PCad.RecordUndo := False;
Alist.PCad.UndoCount := 0;
{$if Defined(ES_GRAPH_SC)}
FileName := ExeDir + '\.blk\TempStream.pwb';
{$else}
FileName := ExtractFileDir(Application.ExeName) + '\.blk\TempStream.pwb';
{$ifend}
TopIndent := 2.5 + 10 + 15;
LeftIndent := 20 + 2;
ToBoxPoints.x := 0;
ToBoxPoints.y := 0;
AList.PCad.Clear(1);
ComponsList := GetFigureComponGraphicalImage(ABox.ID);
PanelsHeightBefore := 0;
PanelsHeight := 0;
if Assigned(ComponsList) then
begin
for i := 0 to ComponsList.Count - 1 do
begin
DesignParams := TComponentDesignParams(ComponsList[i]);
aGraphicalImage := TMemoryStream(DesignParams.GraphicalImage);
aDescription := DesignParams.Description;
aName := DesignParams.Name;
aSign := DesignParams.NameShort;
aMark := DesignParams.NameMark;
ServiceStr := '; ';
aWidth := DesignParams.Width * 100;
aHeightM := DesignParams.Height * 100;
aHeightU := DesignParams.HeightInUnits;
// ïî ñâîéñòâàì Äèçàéíà Øêàôà ñôîðìèðîâàòü ïîäïèñè
aDescription := '';
if GCadForm.FDesignListShowName then
aDescription := aDescription + aName;
if GCadForm.FDesignListShowSign then
aDescription := aDescription + ServiceStr + aSign;
if GCadForm.FDesignListShowMark then
aDescription := aDescription + ServiceStr + aMark;
BlockFig := nil;
if aGraphicalImage <> nil then
begin
aGraphicalImage.SaveToFile(FileName);
BlockFig := TBlock(AList.PCad.InsertBlockwithFileName(1, FileName, LeftIndent, TopIndent));
end
else
begin
if (i <> 0) then
begin
//StampObject := TFigureGrp.create(1, AList.PCad);
LHandle := AList.PCad.GetLayerHandle(1);
UpperStampObj := TRectangle.create(0, 0, 70, 20, 2, ord(psSolid), clBlack, ord(bsClear), clRed, LHandle, mydsNormal, AList.PCad);
TextField := TRichText.create(15, 8, 60, 15, 1, ord(psSolid), clRed, ord(bsClear), clNone,
LHandle, mydsNormal, AList.PCad);
TextField.re.WordWrap := True;
TextField.re.Font.Name := AList.FFontName;
TextField.re.Font.Size := 14;
TextField.re.Font.Style := [fsBold];
TextField.re.Font.Color := clRed;
TextField.re.Lines.Clear;
TextField.re.Lines.Add('NO IMAGE');
BlockFig := TBlock.Create(LHandle, AList.PCad);
BlockFig.AddFigure(UpperStampObj);
BlockFig.AddFigure(TextField);
AList.PCad.AddCustomFigure(1, BlockFig, False);
end;
end;
// Ñàì ØÊÀÔ
if (i = 0) and (aGraphicalImage <> nil) then
begin
aTopBound := DesignParams.TopBound * 100;
aBottomBound := DesignParams.BottomBound * 100;
aLeftBound := DesignParams.LeftBound * 100;
aRightBound := DesignParams.RightBound * 100;
ListFormatKoef := CalcListFormatKoef(aWidth, aHeightM, AList);
OldBoxWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left;
OldBoxHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top;
ReScaleImage(BlockFig, OldBoxWidth, OldBoxHeight, aWidth * ListFormatKoef, aHeightM * ListFormatKoef);
NewBoxWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left;
NewBoxHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top;
BlockFig.move(BlockFig.CenterPoint.x + NewBoxWidth / 2, BlockFig.CenterPoint.y + NewBoxHeight / 2);
BoxHeightKoef := NewBoxHeight / OldBoxHeight;
BoxWidthKoef := NewBoxWidth / OldBoxWidth;
aTopBound := aTopBound * BoxHeightKoef;
aBottomBound := aBottomBound * BoxHeightKoef;
aLeftBound := aLeftBound * BoxWidthKoef;
aRightBound := aRightBound * BoxWidthKoef;
SlotsWidth := NewBoxWidth - aLeftBound - aRightBound;
// ToBoxPoints.x := BlockFig.CenterPoint.x
//ToBoxPoints.x := BlockFig.CenterPoint.x + (aLeftBound - aRightBound)/2 * ListFormatKoef;
ToBoxPoints.x := BlockFig.CenterPoint.x + (aLeftBound - aRightBound)/2;
ToBoxPoints.y := BlockFig.CenterPoint.y - NewBoxHeight / 2 + aTopBound;
// íàðèñîâàòü ëèíåéêó
RulerHeight := aHeightM;
RulerHeight := aHeightU;
CadRulerWidth := aRightBound;
CadRulerHeight := NewBoxHeight - aTopBound - aBottomBound;
BegDrawPoint.x := LeftIndent * 2 + NewBoxWidth - aRightBound;
BegDrawPoint.y := TopIndent * 2 + NewBoxHeight - aBottomBound;
// DrawDesignRulerInMetres(AList, RulerHeight, CadRulerWidth, CadRulerHeight, BegDrawPoint);
DrawDesignRulerInUnits(AList, RulerHeight, CadRulerWidth, CadRulerHeight, BegDrawPoint);
end
else
// Åãî êîìïëåêòóþùèå
begin
ComponWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left;
ComponHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top;
PanelsHeightBefore := PanelsHeightBefore + ComponHeight;
NeedApplayKoef := False;
for j := 0 to BlockFig.InFigures.Count - 1 do
begin
if (TFigure(BlockFig.inFigures[j]) is TWMFObject) or (TFigure(BlockFig.inFigures[j]) is TBMPObject) then
begin
NeedApplayKoef := True;
break;
end;
end;
if NeedApplayKoef then
begin
//ReScaleImage(BlockFig, ComponWidth, ComponHeight, SlotsWidth{aWidth * ListFormatKoef}, koef1_m * aHeightM * ListFormatKoef);
//ReScaleImage(BlockFig, ComponWidth, ComponHeight, SlotsWidth, aHeightM * ListFormatKoef + koef1 * ListFormatKoef);
UCount := Trunc(aHeightM / 4.374);
ReScaleImage(BlockFig, ComponWidth, ComponHeight, SlotsWidth, aHeightM * ListFormatKoef +
(koef1 - (0.006 * UCount)) * ListFormatKoef);
ComponHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top;
ComponWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left;
//ComponHeight := ComponHeight - ComponHeight * koef2_m;
//ComponHeight := ComponHeight - (koef2 * ListFormatKoef);
ComponHeight := ComponHeight - ( (koef2 - (0.006 * UCount)) * ListFormatKoef);
end
else
begin
ReScaleImage(BlockFig, ComponWidth, ComponHeight, SlotsWidth {aWidth * ListFormatKoef}, aHeightM * ListFormatKoef);
ComponHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top;
ComponWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left;
end;
ToBoxPoints.y := ToBoxPoints.y + ComponHeight / 2;
PanelsHeight := PanelsHeight + ComponHeight; //27.04.2011
BlockFig.move(ToBoxPoints.x - BlockFig.CenterPoint.x, ToBoxPoints.y - BlockFig.CenterPoint.y);
// Âûâåñòè îïèñàíèå
DescrPoints.x := LeftIndent * 2 + NewBoxWidth + 2;
DescrPoints.y := ToBoxPoints.y - 3;{3 * ListFormatKoef};
DescrLHandle := AList.PCad.GetLayerHandle(1);
// ÑÎÇÄÀÍÈÅ ÒÅÊÑÒÀ ÎÏÈÑÀÍÈß
DescrObject := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone,
DescrLHandle, mydsNormal, AList.PCad);
DescrObject.re.WordWrap := False;
DescrObject.re.Font.Name := AList.FFontName;
DescrObject.re.Font.Size := 12; // 14
DescrObject.re.Font.Style := [];
DescrObject.re.Lines.Clear;
DescrObject.re.Lines.Add(aDescription);
xCanvas := TMetafileCanvas.Create(DescrObject.Metafile, 0);
xCanvas.Font.Name := DescrObject.re.Font.Name;
xCanvas.Font.Size := DescrObject.re.Font.Size;
xCanvas.Font.Style := DescrObject.re.Font.Style;
GetTextMetrics(xCanvas.Handle, TM);
h := TM.tmHeight / 4;
w := (xCanvas.TextWidth(DescrObject.Re.Lines[0]) + 3) / 4;
FreeAndNil(xCanvas);
FreeAndNil(DescrObject);
DescrObject := TRichText.create(DescrPoints.x, DescrPoints.y, DescrPoints.x + w, DescrPoints.y + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone,
DescrLHandle, mydsNormal, AList.PCad);
DescrObject.re.WordWrap := False;
DescrObject.re.Font.Name := AList.FFontName;
DescrObject.re.Font.Size := 12; // 14
DescrObject.re.Font.Style := [];
DescrObject.re.Lines.Clear;
DescrObject.re.Lines.Add(aDescription);
DescrInsObject := TRichText(AList.PCad.AddCustomFigure(1, DescrObject, False));
// ===
{$IF Defined(SCS_PE) or Defined(BASEADM_SCS) or Defined(SCS_PANDUIT)}
AList.PCad.DeselectAll(1);
BlockFig.Select;
DescrInsObject.Select;
AList.PCad.GroupSelection;
{$IFEND}
ToBoxPoints.y := ToBoxPoints.y + ComponHeight / 2;
end;
if BlockFig <> nil then
BlockFig.Deselect;
if (i = 0) and (aGraphicalImage = nil) then
begin
ShowMessage(cCommon_Mes12);
if ComponsList <> nil then
FreeAndNil(ComponsList);
Alist.PCad.RecordUndo := True;
Alist.PCad.UndoCount := 0;
Exit;
end;
//else
// ToBoxPoints.y := ToBoxPoints.y + aHeightM * ListFormatKoef; //01.10.2012
end;
AList.PCad.SelectAll(1);
AList.PCad.GroupSelection;
FigureGrp := TFigureGrp(AList.PCad.Selection[0]);
NewBoxWidth := FigureGrp.GetBoundRect.Right - FigureGrp.GetBoundRect.Left;
ListX := AList.PCad.WorkWidth - (15 + 10 + 2 * 5) / 2;
// ñìåñòèòü ïîëíîñòüþ
if NewBoxWidth > ListX then
begin
FigureGrp.Scale(ListX / NewBoxWidth, ListX / NewBoxWidth);
FigureGrp.move(LeftIndent - FigureGrp.ap1.x, TopIndent - FigureGrp.ap1.y);
end
else
// ñìåñòèòü òîëüêî ââåðõ
begin
FigureGrp.move(LeftIndent - FigureGrp.ap1.x, TopIndent - FigureGrp.ap1.y);
end;
end;
if ComponsList <> nil then
FreeAndNil(ComponsList);
// AList.CurrentLayer := 1;
{$IF Defined(SCS_PE) or Defined(BASEADM_SCS) or Defined(SCS_PANDUIT)}
//if FigureGrp <> nil then
// FigureGrp.UnGroup;
AList.PCad.UngroupSelection;
AList.PCad.DeselectAll(1);
{$IFEND}
RefreshCAD(AList.PCad);
Alist.PCad.RecordUndo := True;
Alist.PCad.UndoCount := 0;
str := GetListParams(AList.FCADListID).Caption;
LoadCaptionsOnFrame(AList, GetListParams(AList.FCADListID).Settings.CADStampType);
except
on E: Exception do addExceptionToLogEx('U_Common.UpdateDesignList', E.Message);
end;
end;
procedure UpdateDesignListOnBoxChange(AListID: Integer; ABoxID: Integer);
var
Box: TConnectorObject;
BoxList: TF_CAD;
DesingList: TF_CAD;
begin
try
BoxList := GetListByID(AListID);
if BoxList <> nil then
begin
Box := TConnectorObject(GetFigureByID(BoxList, ABoxID));
if Box <> nil then
begin
if Box.FJoinedListIDForBox <> - 1 then
begin
DesingList := GetListByID(Box.FJoinedListIDForBox);
if DesingList <> nil then
UpdateDesignList(DesingList, Box);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.UpdateDesignListOnBoxChange', E.Message);
end;
end;
procedure ReScaleImage(aBlock: TBlock; aCurrX, aCurrY, aTotalX, aTotalY: Double);
var
i: integer;
KoefX, KoefY: double;
FFigure: TFigure;
isScaled: Boolean;
begin
try
KoefX := aTotalX / aCurrX;
KoefY := aTotalY / aCurrY;
isScaled := True;
for i := 0 to aBlock.InFigures.Count - 1 do
begin
FFigure := TFigure(aBlock.InFigures[i]);
if CheckFigureByClassName(FFigure, 'TWMFObject') then
begin
FFigure.Scale(KoefX, KoefY, FFigure.CenterPoint);
isScaled := False;
end;
end;
if isScaled then
ABlock.scale(KoefX, KoefY, aBlock.CenterPoint);
except
on E: Exception do addExceptionToLogEx('U_Common.ReScaleImage', E.Message);
end;
end;
function CalcListFormatKoef(aBoxWidth, aBoxHeight: Double; AList: TF_CAD): Double;
var
ListWidth: Double;
ListHeight: Double;
LimitWidth: Double;
LimitHeight: Double;
KoefWidth: Double;
KoefHeight: Double;
ListBottomParam: Double;
begin
Result := 0;
try
ListWidth := AList.PCad.WorkWidth;
ListHeight := AList.PCad.WorkHeight;
ListBottomParam := 0; //#From Oleg# //14.09.2010
if AList.FCadStampType = stt_simple then
ListBottomParam := 15
else
if AList.FCadStampType = stt_extended then
ListBottomParam := 40
else
if AList.FCadStampType = stt_detailed then
ListBottomParam := 55;
LimitWidth := ListWidth - (15 + 10 + 2 * 5) / 2;
LimitHeight := ListHeight - (5 + 10 + ListBottomParam + 2 * 5 + 20);
KoefWidth := LimitWidth / aBoxWidth;
KoefHeight := LimitHeight / aBoxHeight;
if KoefWidth < KoefHeight then
Result := KoefWidth
else
Result := KoefHeight;
except
on E: Exception do addExceptionToLogEx('U_Common.CalcListFormatKoef', E.Message);
end;
end;
procedure DrawDesignRulerInMetres(aList: TF_CAD; aRulerHeight, aCadRulerWidth, aCadRulerHeight: Double; aBeginDrawPoint: TDoublePoint);
var
i: integer;
Step: Double;
MarkCount: Integer;
LimitStep: Double;
x1, y1, x2, y2: double;
textx, texty: double;
LHandle: Integer;
LineObject: TLine;
TextObject: TText;
aTextHeight: Double;
aTextWidth: Double;
TextGroupObject: TFigureGrp;
TextGroupList: TList;
begin
try
LHandle := 0; //#From Oleg# //14.09.2010
LimitStep := 2;
Step := aCadRulerHeight / aRulerHeight;
MarkCount := Round(aRulerHeight);
TextGroupList := TList.Create;
for i := 0 to MarkCount - 1 do
begin
x1 := aBeginDrawPoint.x;
y1 := aBeginDrawPoint.y - i * Step;
y2 := aBeginDrawPoint.y - i * Step;
if (i mod 10) = 0 then
begin
x2 := aBeginDrawPoint.x + 0.7 * aCadRulerWidth;
aTextHeight := 3;
aTextWidth := 1.5;
end
else
if (i mod 5) = 0 then
begin
x2 := aBeginDrawPoint.x + 0.5 * aCadRulerWidth;
aTextHeight := 2;
aTextWidth := 1;
end
else
begin
x2 := aBeginDrawPoint.x + 0.3 * aCadRulerWidth;
aTextHeight := 1.5;
aTextWidth := 0.75;
end;
if Step < LimitStep then
begin
if (i mod 5) = 0 then
begin
LHandle := aList.PCad.GetLayerHandle(1);
LineObject := TLine.create(x1, y1, x2, y2, 1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, aList.PCad);
LineObject.LockModify := True;
LineObject.LockMove := True;
TextObject := TText.Create(x2, y2, aTextHeight, aTextWidth, IntToStr(i), GCadForm.FFontName,
RUSSIAN_CHARSET, clBlack, LHandle, mydsNormal, aList.PCad);
TextObject.Move(- TextObject.TextLength, - TextObject.TextHeight);
TextObject.LockModify := True;
TextObject.LockMove := True;
TextGroupList.Add(LineObject);
TextGroupList.Add(TextObject);
end
end
else
begin
LHandle := aList.PCad.GetLayerHandle(1);
LineObject := TLine.create(x1, y1, x2, y2, 1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, aList.PCad);
LineObject.LockModify := True;
LineObject.LockMove := True;
TextGroupList.Add(LineObject);
if (i mod 5) = 0 then
begin
TextObject := TText.Create(x2, y2, aTextHeight, aTextWidth, IntToStr(i), GCadForm.FFontName,
RUSSIAN_CHARSET, clBlack, LHandle, mydsNormal, aList.PCad);
TextObject.Move(- TextObject.TextLength, - TextObject.TextHeight);
TextObject.LockModify := True;
TextObject.LockMove := True;
TextGroupList.Add(TextObject);
end;
end;
end;
TextGroupObject := TFigureGrp.create(LHandle, aList.PCad);
for i := 0 to TextGroupList.Count - 1 do
TextGroupObject.AddFigure(TFigure(TextGroupList[i]));
aList.PCad.AddCustomFigure(1, TextGroupObject, False);
if TextGroupList <> nil then
FreeAndNil(TextGroupList);
except
on E: Exception do addExceptionToLogEx('U_Common.DrawDesignRulerInMetres', E.Message);
end;
end;
procedure DrawDesignRulerInUnits(aList: TF_CAD; aRulerHeight, aCadRulerWidth, aCadRulerHeight: Double; aBeginDrawPoint: TDoublePoint);
var
i: integer;
Step: Double;
MarkCount: Integer;
LimitStep: Double;
x1, y1, x2, y2: double;
textx, texty: double;
LHandle: Integer;
LineObject: TLine;
TextObject: TRichText;
aTextHeight: Double;
aTextWidth: Double;
TextGroupObject: TFigureGrp;
TextGroupList: TList;
TM: TTextMetric;
xCanvas: TMetafileCanvas;
h, w: double;
begin
try
LimitStep := 2;
Step := aCadRulerHeight / aRulerHeight;
MarkCount := Round(aRulerHeight);
TextGroupList := TList.Create;
for i := 0 to MarkCount - 1 do
begin
x1 := aBeginDrawPoint.x;
y1 := aBeginDrawPoint.y - i * Step;
y2 := aBeginDrawPoint.y - i * Step;
if (i mod 5) = 0 then
begin
x2 := aBeginDrawPoint.x + 0.7 * aCadRulerWidth;
aTextHeight := 3;
aTextWidth := 1.5;
end
else
begin
x2 := aBeginDrawPoint.x + 0.5 * aCadRulerWidth;
aTextHeight := 2;
aTextWidth := 1;
end;
if Step < LimitStep then
begin
if (i mod 5) = 0 then
begin
LHandle := aList.PCad.GetLayerHandle(1);
LineObject := TLine.create(x1, y1, x2, y2, 1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, aList.PCad);
LineObject.LockModify := True;
LineObject.LockMove := True;
TextObject := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone,
LHandle, mydsNormal, GCadForm.PCad);
TextObject.re.Font.Name := GCadForm.FFontName;
TextObject.re.Font.Size := 12;
TextObject.re.Font.Style := [];
TextObject.re.Lines.Clear;
TextObject.re.Lines.Add(IntToStr(i));
xCanvas := TMetafileCanvas.Create(TextObject.Metafile, 0);
xCanvas.Font.Name := TextObject.re.Font.Name;
xCanvas.Font.Size := TextObject.re.Font.Size;
xCanvas.Font.Style := TextObject.re.Font.Style;
GetTextMetrics(xCanvas.Handle, TM);
h := TM.tmHeight / 4;
w := (xCanvas.TextWidth(TextObject.Re.Lines[0]) + 3) / 4;
FreeAndNil(xCanvas);
FreeAndNil(TextObject);
TextObject := TRichText.create(x2, y2, x2 + w, y2 + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone,
LHandle, mydsNormal, GCadForm.PCad);
TextObject.re.Font.Name := GCadForm.FFontName;
TextObject.re.Font.Size := 12;
TextObject.re.Font.Style := [];
TextObject.re.Lines.Clear;
TextObject.re.Lines.Add(IntToStr(i));
TextObject.Move(- w, - h);
TextObject.LockModify := True;
TextObject.LockMove := True;
TextGroupList.Add(LineObject);
TextGroupList.Add(TextObject);
end
end
else
begin
LHandle := aList.PCad.GetLayerHandle(1);
LineObject := TLine.create(x1, y1, x2, y2, 1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, aList.PCad);
LineObject.LockModify := True;
LineObject.LockMove := True;
TextGroupList.Add(LineObject);
if (i mod 5) = 0 then
begin
TextObject := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone,
LHandle, mydsNormal, GCadForm.PCad);
TextObject.re.Font.Name := GCadForm.FFontName;
TextObject.re.Font.Size := 12;
TextObject.re.Font.Style := [];
TextObject.re.Lines.Clear;
TextObject.re.Lines.Add(IntToStr(i));
xCanvas := TMetafileCanvas.Create(TextObject.Metafile, 0);
xCanvas.Font.Name := TextObject.re.Font.Name;
xCanvas.Font.Size := TextObject.re.Font.Size;
xCanvas.Font.Style := TextObject.re.Font.Style;
GetTextMetrics(xCanvas.Handle, TM);
h := TM.tmHeight / 4;
w := (xCanvas.TextWidth(TextObject.Re.Lines[0]) + 3) / 4;
FreeAndNil(xCanvas);
FreeAndNil(TextObject);
TextObject := TRichText.create(x2, y2, x2 + w, y2 + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone,
LHandle, mydsNormal, GCadForm.PCad);
TextObject.re.Font.Name := GCadForm.FFontName;
TextObject.re.Font.Size := 12;
TextObject.re.Font.Style := [];
TextObject.re.Lines.Clear;
TextObject.re.Lines.Add(IntToStr(i));
TextObject.Move(- w, - h);
TextObject.LockModify := True;
TextObject.LockMove := True;
TextGroupList.Add(TextObject);
end;
end;
end;
TextGroupObject := TFigureGrp.create(LHandle, aList.PCad);
for i := 0 to TextGroupList.Count - 1 do
TextGroupObject.AddFigure(TFigure(TextGroupList[i]));
aList.PCad.AddCustomFigure(1, TextGroupObject, False);
if TextGroupList <> nil then
FreeAndNil(TextGroupList);
except
on E: Exception do addExceptionToLogEx('U_Common.DrawDesignRulerInUnits', E.Message);
end;
end;
procedure DisableActForReadOnlyMode;
var
i: integer;
begin
if GReadOnlyMode then
begin
for i := 0 to FSCS_Main.ActionManager.ActionCount - 1 do
begin
if (FSCS_Main.ActionManager.Actions[i].Category = 'Tools') or (FSCS_Main.ActionManager.Actions[i].Category = 'Èíñòðóìåíòû') then
(FSCS_Main.ActionManager.Actions[i] as TAction).Enabled := False;
end;
FSCS_Main.aSaveRevision.Enabled := False;
FSCS_Main.aViewRevs.Enabled := False;
FSCS_Main.aCreateProjectPlan.Enabled := False;
FSCS_Main.aCreateNormsOnCad.Enabled := False;
FSCS_Main.aMasterAutoTrace.Enabled := False;
FSCS_Main.aMasterAutoTraceElectric.Enabled := False;
FSCS_Main.aMasterCableTracing.Enabled := False;
FSCS_Main.aMasterCableChannel.Enabled := False;
FSCS_Main.aMasterUpdateComponPriceFromXF.Enabled := False;
FSCS_Main.aToolSelect.Enabled := True;
FSCS_Main.aToolPan.Enabled := True;
end;
end;
procedure EnableOptionsForNormalList;
begin
try
FSCS_Main.aSaveAsSubstrate.Enabled := True;
FSCS_Main.aImport.Enabled := True;
FSCS_Main.aUndo.Enabled := True;
FSCS_Main.aRedo.Enabled := True;
FSCS_Main.aCopy.Enabled := True;
FSCS_Main.aCut.Enabled := True;
FSCS_Main.aPaste.Enabled := True;
FSCS_Main.aSelectAll.Enabled := True;
FSCS_Main.aViewLayers.Enabled := True;
FSCS_Main.aRotate.Enabled := True;
FSCS_Main.aBackwards.Enabled := True;
FSCS_Main.aForward.Enabled := True;
FSCS_Main.aGrouping.Enabled := True;
FSCS_Main.aUngrouping.Enabled := True;
FSCS_Main.aLock.Enabled := True;
FSCS_Main.aUnlock.Enabled := True;
FSCS_Main.aObjProperties.Enabled := True;
FSCS_Main.aLoadSubstrate.Enabled := True;
// FSCS_Main.aViewProjectManager.Enabled := True;
FSCS_Main.aDelete.Enabled := True;
FSCS_Main.aDeleteAll.Enabled := True;
FSCS_Main.aDeSelectAll.Enabled := True;
FSCS_Main.aInsertText.Enabled := True;
FSCS_Main.aInsertBitmap.Enabled := True;
FSCS_Main.aPenStyle.Enabled := True;
FSCS_Main.aPenWidth.Enabled := True;
FSCS_Main.aRowStyle.Enabled := True;
FSCS_Main.aBrushStyle.Enabled := True;
FSCS_Main.aTextCharset.Enabled := True;
FSCS_Main.aFontStyle.Enabled := True;
FSCS_Main.aFormatOrder.Enabled := True;
FSCS_Main.aFormatAlign.Enabled := True;
FSCS_Main.aSnaptoGrid.Enabled := True;
FSCS_Main.aSnaptoGuides.Enabled := True;
FSCS_Main.aSnaptoNearObject.Enabled := True;
FSCS_Main.aSendtoBack.Enabled := True;
FSCS_Main.aBringtoFront.Enabled := True;
FSCS_Main.aSendBackwards.Enabled := True;
FSCS_Main.aBringForwards.Enabled := True;
FSCS_Main.aMoveSelection.Enabled := True;
FSCS_Main.aRotateSelection.Enabled := True;
FSCS_Main.aDuplicateSelection.Enabled := True;
FSCS_Main.aMirrorSelection.Enabled := True;
FSCS_Main.aToolLine.Enabled := True;
FSCS_Main.aToolRectangle.Enabled := True;
FSCS_Main.aToolEllipse.Enabled := True;
FSCS_Main.aToolCircle.Enabled := True;
FSCS_Main.aToolArc.Enabled := True;
FSCS_Main.aToolElipticArc.Enabled := True;
FSCS_Main.aToolPolyLine.Enabled := True;
FSCS_Main.aToolPoint.Enabled := True;
FSCS_Main.aToolText.Enabled := True;
FSCS_Main.aToolRichText.Enabled := True;
FSCS_Main.aToolKnife.Enabled := True;
FSCS_Main.aToolHDimLine.Enabled := True;
FSCS_Main.aToolVDimLine.Enabled := True;
FSCS_Main.aTextFont.Enabled := True;
FSCS_Main.aTextSize.Enabled := True;
FSCS_Main.aToolMultiLine.Enabled := True;
{$if Not Defined(ES_GRAPH_SC)}
FSCS_Main.aToolOrthoLine.Enabled := True;
FSCS_Main.aToolOrthoLineExt.Enabled := True;
{$ifend}
FSCS_Main.aSetSubstrateLayer.Enabled := True;
FSCS_Main.aSetSCSLayer.Enabled := True;
FSCS_Main.aAutoSelectTrace.Enabled := True;
FSCS_Main.aOpenProject.Enabled := True;
FSCS_Main.aToolText.Enabled := True;
FSCS_Main.aViewSCSObjectsProp.Enabled := True;
FSCS_Main.aCreateRaise.Enabled := True;
FSCS_Main.aDestroyRaise.Enabled := True;
FSCS_Main.aMasterAutoTrace.Enabled := True;
FSCS_Main.aRaiseLine.Enabled := True;
FSCS_Main.aCreateObjectOnClick.Enabled := True;
FSCS_Main.aShowConnFullness.Enabled := True;
FSCS_Main.aShowCableFullness.Enabled := True;
FSCS_Main.aShowCableChannelFullness.Enabled := True;
FSCS_Main.aCreateObjectOnClickTool.Enabled := True;
FSCS_Main.aCreateBlockToFile.Enabled := True;
FSCS_Main.aCreateBlockToNB.Enabled := True;
FSCS_Main.aInsertBlock.Enabled := True;
{$if Not Defined(ES_GRAPH_SC)}
//30.05.2011 FSCS_Main.aShiftUpObject.Enabled := True;
//30.05.2011 FSCS_Main.aShiftDownObject.Enabled := True;
//30.05.2011 FSCS_Main.aShiftLeftObject.Enabled := True;
//30.05.2011 FSCS_Main.aShiftRightObject.Enabled := True;
{$ifend}
FSCS_Main.aDesignBox.Enabled := True;
FSCS_Main.aShowTracesLengthLimit.Enabled := True;
FSCS_Main.aNoMoveConnectedObjects.Enabled := True;
// Add
FSCS_Main.aLoadFPlan.Enabled := True;
FSCS_Main.aSaveFPlan.Enabled := True;
{$if Not Defined(ES_GRAPH_SC)}
FSCS_Main.aConnectionsConfigurator.Enabled := True;
FSCS_Main.aMasterCableTracing.Enabled := True;
FSCS_Main.aMasterCableChannel.Enabled := True;
FSCS_Main.aToolCabinet.Enabled := True;
FSCS_Main.aToolWallRect.Enabled := True;
FSCS_Main.aToolWallPath.Enabled := True;
{$ifend}
FSCS_Main.cbLayers.Enabled := True;
FSCS_Main.aExport.Enabled := True;
FSCS_Main.aExportDWG.Enabled := True;
{$if Not Defined(ES_GRAPH_SC)}
FSCS_Main.aToolHouse.Enabled := True;
{$ifend}
except
on E: Exception do addExceptionToLogEx('U_Common.EnableOptionsForNormalList', E.Message);
end;
DisableActForReadOnlyMode;
end;
procedure DisableOptionsForDesignList;
begin
try
FSCS_Main.aSaveAsSubstrate.Enabled := False;
FSCS_Main.aImport.Enabled := False;
FSCS_Main.aUndo.Enabled := True;
FSCS_Main.aRedo.Enabled := True;
FSCS_Main.aCopy.Enabled := False;
FSCS_Main.aCut.Enabled := False;
FSCS_Main.aPaste.Enabled := False;
FSCS_Main.aSelectAll.Enabled := False;
FSCS_Main.aViewLayers.Enabled := False;
FSCS_Main.aRotate.Enabled := False;
FSCS_Main.aBackwards.Enabled := True;
FSCS_Main.aForward.Enabled := True;
FSCS_Main.aGrouping.Enabled := True;
FSCS_Main.aUngrouping.Enabled := True;
FSCS_Main.aLock.Enabled := False;
FSCS_Main.aUnlock.Enabled := False;
FSCS_Main.aObjProperties.Enabled := False;
FSCS_Main.aLoadSubstrate.Enabled := False;
// FSCS_Main.aViewProjectManager.Enabled := False;
FSCS_Main.aDelete.Enabled := False;
FSCS_Main.aDeleteAll.Enabled := False;
FSCS_Main.aDeSelectAll.Enabled := False;
FSCS_Main.aInsertText.Enabled := True;
FSCS_Main.aInsertBitmap.Enabled := True;
FSCS_Main.aPenStyle.Enabled := False;
FSCS_Main.aPenWidth.Enabled := False;
FSCS_Main.aRowStyle.Enabled := False;
FSCS_Main.aBrushStyle.Enabled := False;
FSCS_Main.aTextCharset.Enabled := False;
FSCS_Main.aFontStyle.Enabled := False;
FSCS_Main.aFormatOrder.Enabled := False;
FSCS_Main.aFormatAlign.Enabled := False;
FSCS_Main.aSnaptoGrid.Enabled := False;
FSCS_Main.aSnaptoGuides.Enabled := False;
FSCS_Main.aSnaptoNearObject.Enabled := False;
FSCS_Main.aSendtoBack.Enabled := True;
FSCS_Main.aBringtoFront.Enabled := True;
FSCS_Main.aSendBackwards.Enabled := True;
FSCS_Main.aBringForwards.Enabled := True;
FSCS_Main.aMoveSelection.Enabled := False;
FSCS_Main.aRotateSelection.Enabled := False;
FSCS_Main.aDuplicateSelection.Enabled := False;
FSCS_Main.aMirrorSelection.Enabled := False;
FSCS_Main.aToolLine.Enabled := False;
FSCS_Main.aToolRectangle.Enabled := False;
FSCS_Main.aToolEllipse.Enabled := False;
FSCS_Main.aToolCircle.Enabled := False;
FSCS_Main.aToolArc.Enabled := False;
FSCS_Main.aToolElipticArc.Enabled := False;
FSCS_Main.aToolPolyLine.Enabled := False;
FSCS_Main.aToolPoint.Enabled := False;
FSCS_Main.aToolText.Enabled := True;
FSCS_Main.aToolRichText.Enabled := True;
FSCS_Main.aToolKnife.Enabled := False;
FSCS_Main.aToolHDimLine.Enabled := False;
FSCS_Main.aToolVDimLine.Enabled := False;
FSCS_Main.aTextFont.Enabled := False;
FSCS_Main.aTextSize.Enabled := False;
FSCS_Main.aToolMultiLine.Enabled := False;
FSCS_Main.aToolOrthoLine.Enabled := False;
FSCS_Main.aToolOrthoLineExt.Enabled := False;
FSCS_Main.aSetSubstrateLayer.Enabled := False;
FSCS_Main.aSetSCSLayer.Enabled := False;
FSCS_Main.aAutoSelectTrace.Enabled := False;
FSCS_Main.aOpenProject.Enabled := False;
FSCS_Main.aViewSCSObjectsProp.Enabled := False;
FSCS_Main.aCreateRaise.Enabled := False;
FSCS_Main.aDestroyRaise.Enabled := False;
FSCS_Main.aMasterAutoTrace.Enabled := False;
FSCS_Main.aRaiseLine.Enabled := False;
FSCS_Main.aNoMoveConnectedObjects.Enabled := False;
FSCS_Main.aCreateObjectOnClick.Enabled := False;
FSCS_Main.aShowConnFullness.Enabled := False;
FSCS_Main.aShowCableFullness.Enabled := False;
FSCS_Main.aShowCableChannelFullness.Enabled := False;
FSCS_Main.aCreateObjectOnClickTool.Enabled := False;
FSCS_Main.aCreateBlockToFile.Enabled := False;
FSCS_Main.aCreateBlockToNB.Enabled := False;
FSCS_Main.aInsertBlock.Enabled := True;
FSCS_Main.aShiftUpObject.Enabled := False;
FSCS_Main.aShiftDownObject.Enabled := False;
FSCS_Main.aShiftLeftObject.Enabled := False;
FSCS_Main.aShiftRightObject.Enabled := False;
FSCS_Main.aDesignBox.Enabled := False;
FSCS_Main.aShowTracesLengthLimit.Enabled := False;
// FSCS_Main.cbLayers.Clear;
FSCS_Main.cbLayers.Enabled := False;
// Add
FSCS_Main.aLoadFPlan.Enabled := False;
FSCS_Main.aSaveFPlan.Enabled := False;
FSCS_Main.aConnectionsConfigurator.Enabled := False;
FSCS_Main.aMasterCableTracing.Enabled := False;
FSCS_Main.aMasterCableChannel.Enabled := False;
FSCS_Main.aToolCabinet.Enabled := False;
FSCS_Main.aToolWallRect.Enabled := False;
FSCS_Main.aToolWallPath.Enabled := False;
FSCS_Main.aExport.Enabled := True;
FSCS_Main.aExportDWG.Enabled := True;
FSCS_Main.aToolHouse.Enabled := False;
except
on E: Exception do addExceptionToLogEx('U_Common.DisableOptionsForDesignList', E.Message);
end;
end;
procedure DisableOptionsForProjectPlan;
begin
try
FSCS_Main.aSaveAsSubstrate.Enabled := False;
FSCS_Main.aImport.Enabled := False;
FSCS_Main.aUndo.Enabled := True;
FSCS_Main.aRedo.Enabled := True;
FSCS_Main.aCopy.Enabled := False;
FSCS_Main.aCut.Enabled := False;
FSCS_Main.aPaste.Enabled := False;
FSCS_Main.aSelectAll.Enabled := False;
FSCS_Main.aViewLayers.Enabled := False;
FSCS_Main.aRotate.Enabled := False;
FSCS_Main.aBackwards.Enabled := False;
FSCS_Main.aForward.Enabled := False;
FSCS_Main.aGrouping.Enabled := False;
FSCS_Main.aUngrouping.Enabled := False;
FSCS_Main.aLock.Enabled := False;
FSCS_Main.aUnlock.Enabled := False;
FSCS_Main.aObjProperties.Enabled := False;
FSCS_Main.aLoadSubstrate.Enabled := False;
// FSCS_Main.aViewProjectManager.Enabled := False;
FSCS_Main.aDelete.Enabled := False;
FSCS_Main.aDeleteAll.Enabled := False;
FSCS_Main.aDeSelectAll.Enabled := False;
FSCS_Main.aInsertText.Enabled := True;
FSCS_Main.aInsertBitmap.Enabled := True;
FSCS_Main.aPenStyle.Enabled := False;
FSCS_Main.aPenWidth.Enabled := False;
FSCS_Main.aRowStyle.Enabled := False;
FSCS_Main.aBrushStyle.Enabled := False;
FSCS_Main.aTextCharset.Enabled := False;
FSCS_Main.aFontStyle.Enabled := False;
FSCS_Main.aFormatOrder.Enabled := False;
FSCS_Main.aFormatAlign.Enabled := False;
FSCS_Main.aSnaptoGrid.Enabled := False;
FSCS_Main.aSnaptoGuides.Enabled := False;
FSCS_Main.aSnaptoNearObject.Enabled := False;
FSCS_Main.aSendtoBack.Enabled := False;
FSCS_Main.aBringtoFront.Enabled := False;
FSCS_Main.aSendBackwards.Enabled := False;
FSCS_Main.aBringForwards.Enabled := False;
FSCS_Main.aMoveSelection.Enabled := False;
FSCS_Main.aRotateSelection.Enabled := False;
FSCS_Main.aDuplicateSelection.Enabled := False;
FSCS_Main.aMirrorSelection.Enabled := False;
FSCS_Main.aToolLine.Enabled := False;
FSCS_Main.aToolRectangle.Enabled := False;
FSCS_Main.aToolEllipse.Enabled := False;
FSCS_Main.aToolCircle.Enabled := False;
FSCS_Main.aToolArc.Enabled := False;
FSCS_Main.aToolElipticArc.Enabled := False;
FSCS_Main.aToolPolyLine.Enabled := False;
FSCS_Main.aToolPoint.Enabled := False;
FSCS_Main.aToolText.Enabled := False;
FSCS_Main.aToolRichText.Enabled := False;
FSCS_Main.aToolKnife.Enabled := False;
FSCS_Main.aToolHDimLine.Enabled := False;
FSCS_Main.aToolVDimLine.Enabled := False;
FSCS_Main.aTextFont.Enabled := False;
FSCS_Main.aTextSize.Enabled := False;
FSCS_Main.aToolMultiLine.Enabled := False;
FSCS_Main.aToolOrthoLine.Enabled := False;
FSCS_Main.aToolOrthoLineExt.Enabled := False;
FSCS_Main.aSetSubstrateLayer.Enabled := False;
FSCS_Main.aSetSCSLayer.Enabled := False;
FSCS_Main.aAutoSelectTrace.Enabled := False;
FSCS_Main.aOpenProject.Enabled := False;
FSCS_Main.aViewSCSObjectsProp.Enabled := False;
FSCS_Main.aCreateRaise.Enabled := False;
FSCS_Main.aDestroyRaise.Enabled := False;
FSCS_Main.aMasterAutoTrace.Enabled := False;
FSCS_Main.aRaiseLine.Enabled := False;
FSCS_Main.aNoMoveConnectedObjects.Enabled := False;
FSCS_Main.aCreateObjectOnClick.Enabled := False;
FSCS_Main.aShowConnFullness.Enabled := False;
FSCS_Main.aShowCableFullness.Enabled := False;
FSCS_Main.aShowCableChannelFullness.Enabled := False;
FSCS_Main.aCreateObjectOnClickTool.Enabled := False;
FSCS_Main.aCreateBlockToFile.Enabled := False;
FSCS_Main.aCreateBlockToNB.Enabled := False;
FSCS_Main.aInsertBlock.Enabled := True;
FSCS_Main.aShiftUpObject.Enabled := False;
FSCS_Main.aShiftDownObject.Enabled := False;
FSCS_Main.aShiftLeftObject.Enabled := False;
FSCS_Main.aShiftRightObject.Enabled := False;
FSCS_Main.aDesignBox.Enabled := False;
FSCS_Main.aShowTracesLengthLimit.Enabled := False;
// FSCS_Main.cbLayers.Clear;
FSCS_Main.cbLayers.Enabled := False;
// Add
FSCS_Main.aLoadFPlan.Enabled := False;
FSCS_Main.aSaveFPlan.Enabled := False;
FSCS_Main.aConnectionsConfigurator.Enabled := False;
FSCS_Main.aMasterCableTracing.Enabled := False;
FSCS_Main.aMasterCableChannel.Enabled := False;
FSCS_Main.aExport.Enabled := True;
FSCS_Main.aExportDWG.Enabled := True;
FSCS_Main.aToolHouse.Enabled := False;
except
on E: Exception do addExceptionToLogEx('U_Common.DisableOptionsForProjectPlan', E.Message);
end;
end;
// ôóíêöèÿ ïîëó÷åíèÿ íîìåðà layera ïî åãî õåíäëó
function GLN(aLHandle: LongInt): integer;
var
i: integer;
begin
result := 1;
try
for i := 0 to GCadForm.PCad.LayerCount - 1 do
begin
if GCadForm.PCad.GetLayerHandle(i) = aLHandle then
begin
result := i;
break;
end;
end;
except
end;
end;
// ïðîöåäóðà äëÿ çàãðóçêè ìàêåòà ýòàæà
procedure LoadFrameToList(aCad: TF_CAD; aMainStampName, aSideStampName: string; aListFormat: TListFormatType);
var
i, j: integer;
LHandle: integer;
FrameFileName: string;
StampObject: TFigureGrp;
RectangleObj: TRectangle;
MainStampObj: TBlock;
SideStampObj: TBlock;
UpperStampObj: TRectangle;
Bnd: TDoubleRect;
deltax, deltay: double;
FramePos: TDoublePoint;
BlockFig: TBlock;
InFigure: TFigure;
InFigureGrp: TFigureGrp;
begin
try
GAutoDelete := True;
RemoveFrameFromList(aCad);
GAutoDelete := False;
if FileExists(aMainStampName) and FileExists(aSideStampName) then
begin
LHandle := aCad.PCad.GetLayerHandle(7);
FramePos.x := aCad.PCad.WorkWidth / 2;
FramePos.y := aCad.PCad.WorkHeight / 2;
try
// ñ÷èòàòü îñíîâíîé øòàìï
MainStampObj := TBlock(aCad.PCad.GetFigureByDataID(100)); //10.11.2011
//if MainStampObj = nil then
MainStampObj := TBlock(aCad.PCad.InsertBlockwithFileName(7, aMainStampName, -1000, -1000));
MainStampObj.Deselect;
// ñ÷èòàòü áîêîâîé øòàïì
SideStampObj := TBlock(aCad.PCad.InsertBlockwithFileName(7, aSideStampName, -1000, -1000));
SideStampObj.Deselect;
// íàðèñîâàòü âåðõíèé øòàìï
UpperStampObj := TRectangle.create(-1000, -1000, -1000 + 70, -1000 + 15, 2, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, aCad.PCad);
// íàðèñîâàòü ñàìó ðàìêó
Bnd.Left := aListFormat.StampFields.Margins.Left; //20;
Bnd.Top := aListFormat.StampFields.Margins.Top; //5;
Bnd.Right := aListFormat.PageWidth - aListFormat.StampFields.Margins.Right; //5;
Bnd.Bottom := aListFormat.PageHeight - aListFormat.StampFields.Margins.Bottom; //5;
RectangleObj := TRectangle.create(Bnd.Left, Bnd.Top, Bnd.Right, Bnd.Bottom, 2, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, aCad.PCad);
// ïåðåäâèíóòü øòàìïû
deltax := Bnd.Left - UpperStampObj.ap1.x;
deltay := Bnd.Top - UpperStampObj.ap1.y;
UpperStampObj.Move(deltax, deltay);
deltax := Bnd.Left - SideStampObj.ap3.x;
deltay := Bnd.Bottom - SideStampObj.ap3.y;
SideStampObj.move(deltax, deltay);
deltax := Bnd.Right - MainStampObj.ap3.x;
deltay := Bnd.Bottom - MainStampObj.ap3.y;
MainStampObj.move(deltax, deltay);
// âèçèáë/èíâèçèáë øòàìïû
MainStampObj.Visible := aListFormat.ShowMainStamp;
SetAllInFiguresVisible(MainStampObj, aListFormat.ShowMainStamp);
SideStampObj.Visible := aListFormat.ShowSideStamp;
SetAllInFiguresVisible(SideStampObj, aListFormat.ShowSideStamp);
UpperStampObj.Visible := aListFormat.ShowUpperStamp;
{$if Defined(SCS_PE) or Defined(SCS_PANDUIT)}
RectangleObj.Visible := aListFormat.ShowUpperStamp or aListFormat.ShowSideStamp or aListFormat.ShowMainStamp;
{$ifend}
RectangleObj.DataID := 99;
MainStampObj.DataID := 100;
SideStampObj.DataID := 200;
UpperStampObj.DataID := 300;
// ñãðóïïèðîâàòü
StampObject := TFigureGrp.create(LHandle, aCad.PCad);
StampObject.AddFigure(RectangleObj);
StampObject.AddFigure(MainStampObj);
StampObject.AddFigure(SideStampObj);
StampObject.AddFigure(UpperStampObj);
GCadForm.PCad.Figures.Remove(MainStampObj);
GCadForm.PCad.Figures.Remove(SideStampObj);
SetAllStampFiguresLayer(StampObject, LHandle);
SetAllStampTextsFont(StampObject, GCadForm.FFontName);
aCad.PCad.AddCustomFigure(7, StampObject, False);
// âûñòàâèòü ïîäïèñè
LoadCaptionsOnFrame(aCad, aCad.FCadStampType);
aCad.FFrameFileName := StampObject.Name;
except
aCad.FFrameFileName := '';
end;
end
else
begin
aCad.FFrameFileName := '';
end;
RefreshCAD(aCad.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.LoadFrameToList', E.Message);
end;
end;
procedure LoadFrameOnMaket(aPCad: TPowerCad);
var
i, j: integer;
LHandle: integer;
FrameFileName: string;
StampObject: TFigureGrp;
RectangleObj: TRectangle;
MainStampObj: TBlock;
SideStampObj: TBlock;
UpperStampObj: TRectangle;
Bnd: TDoubleRect;
deltax, deltay: double;
FramePos: TDoublePoint;
BlockFig: TBlock;
InFigure: TFigure;
InFigureGrp: TFigureGrp;
FullPathName, MainStampName, SideStampName, StampTypeStr, StampLangStr: string;
PageWidth, PageHeight: double;
begin
try
aPCad.Clear(0);
// îïðåäåëèòü ïàðàìåòðû â èìåíàõ áëîêîâ
{$if Defined(ES_GRAPH_SC)}
FullPathName := ExeDir + '\Stamp\';
{$else}
FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\';
{$ifend}
if F_MasterNewListLite.rbSimple.Checked then
StampTypeStr := 'Small';
if F_MasterNewListLite.rbExtended.Checked then
StampTypeStr := 'Big';
if F_MasterNewListLite.rbDetailed.Checked then
StampTypeStr := 'ExtBig';
// if F_MasterNewListLite.rbRus.Checked then
// StampLangStr := 'eng';
if F_MasterNewListLite.rbUkr.Checked then
StampLangStr := 'ukr';
if F_MasterNewListLite.rbRus.Checked then
StampLangStr := 'rus';
//
MainStampName := FullPathName + StampTypeStr + '_Main_' + StampLangStr + '.sch';
SideStampName := FullPathName + StampTypeStr + '_Side_' + StampLangStr + '.sch';
if FileExists(MainStampName) and FileExists(SideStampName) then
begin
LHandle := aPCad.GetLayerHandle(0);
FramePos.x := aPCad.WorkWidth / 2;
FramePos.y := aPCad.WorkHeight / 2;
PageWidth := StrToFloat_My(F_MasterNewListLite.edWidth.Text);
PageHeight := StrToFloat_My(F_MasterNewListLite.edHeight.Text);
// ñ÷èòàòü îñíîâíîé øòàìï
MainStampObj := TBlock(aPCad.InsertBlockwithFileName(0, MainStampName, -1000, -1000));
MainStampObj.Deselect;
// ñ÷èòàòü áîêîâîé øòàïì
SideStampObj := TBlock(aPCad.InsertBlockwithFileName(0, SideStampName, -1000, -1000));
SideStampObj.Deselect;
// íàðèñîâàòü âåðõíèé øòàìï
UpperStampObj := TRectangle.create(-1000, -1000, -1000 + 70, -1000 + 15, 2, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, aPCad);
// íàðèñîâàòü ñàìó ðàìêó
Bnd.Left := F_MasterNewListLite.seStampMarginLeft.Value; //20;
Bnd.Top := F_MasterNewListLite.seStampMarginTop.Value; // 5;
Bnd.Right := PageWidth - F_MasterNewListLite.seStampMarginRight.Value; //5;
Bnd.Bottom := PageHeight - F_MasterNewListLite.seStampMarginBottom.Value; //5;
RectangleObj := TRectangle.create(Bnd.Left, Bnd.Top, Bnd.Right, Bnd.Bottom, 2, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, aPCad);
// ïåðåäâèíóòü øòàìïû
deltax := Bnd.Left - UpperStampObj.ap1.x;
deltay := Bnd.Top - UpperStampObj.ap1.y;
UpperStampObj.Move(deltax, deltay);
deltax := Bnd.Left - SideStampObj.ap3.x;
deltay := Bnd.Bottom - SideStampObj.ap3.y;
SideStampObj.move(deltax, deltay);
deltax := Bnd.Right - MainStampObj.ap3.x;
deltay := Bnd.Bottom - MainStampObj.ap3.y;
MainStampObj.move(deltax, deltay);
// âèçèáë/èíâèçèáë øòàìïû
MainStampObj.Visible := F_MasterNewListLite.cbShowMainStamp.Checked;
SetAllInFiguresVisible(MainStampObj, F_MasterNewListLite.cbShowMainStamp.Checked);
SideStampObj.Visible := F_MasterNewListLite.cbShowSideStamp.Checked;
SetAllInFiguresVisible(SideStampObj, F_MasterNewListLite.cbShowSideStamp.Checked);
UpperStampObj.Visible := F_MasterNewListLite.cbShowUpperStamp.Checked;
{$if Defined(SCS_PE) or Defined(SCS_PANDUIT)}
RectangleObj.Visible := MainStampObj.Visible or SideStampObj.Visible or UpperStampObj.Visible;
{$ifend}
RectangleObj.DataID := 99;
// ñãðóïïèðîâàòü
StampObject := TFigureGrp.create(LHandle, aPCad);
StampObject.AddFigure(RectangleObj);
StampObject.AddFigure(MainStampObj);
StampObject.AddFigure(SideStampObj);
StampObject.AddFigure(UpperStampObj);
aPCad.Figures.Remove(MainStampObj);
aPCad.Figures.Remove(SideStampObj);
SetAllStampFiguresLayer(StampObject, LHandle);
SetAllStampTextsFont(StampObject, F_MasterNewListLite.cbFontName.FontName);
aPCad.AddCustomFigure(0, StampObject, False);
RefreshCAD(aPCad);
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.LoadFrameOnMaket', E.Message);
end;
end;
procedure RemoveFrameFromList(aCad: TF_CAD);
var
FullPathName: string;
FName: string;
i: Integer;
FrameFigure: TFigure;
begin
try
FullPathName := ExtractSaveDir;
FName := ExtractFileName(aCad.FFrameFileName);
if FName = '' then
FName := 'Unknown.sch';
FullPathName := FullPathName + '\' + FName;
{//17.11.2011
if aCad.FFrameProjectName <> nil then
begin
aCad.PCad.Figures.Remove(aCad.FFrameProjectName);
FreeAndNil(aCad.FFrameProjectName);
end;
if aCad.FFrameListName <> nil then
begin
aCad.PCad.Figures.Remove(aCad.FFrameListName);
FreeAndNil(aCad.FFrameListName);
end;
if aCad.FFrameCodeName <> nil then
begin
aCad.PCad.Figures.Remove(aCad.FFrameCodeName);
FreeAndNil(aCad.FFrameCodeName);
end;
if aCad.FFrameIndexName <> nil then
begin
aCad.PCad.Figures.Remove(aCad.FFrameIndexName);
FreeAndNil(aCad.FFrameIndexName);
end;}
try
for i := 0 to aCad.FFrameObjects.Count - 1 do
begin
FrameFigure := TFigure(aCad.FFrameObjects.Objects[i]);
if FrameFigure <> nil then
begin
aCad.PCad.Figures.Remove(FrameFigure);
FreeAndNil(FrameFigure);
aCad.FFrameObjects.Objects[i] := nil;
end;
end;
finally
aCad.ClearFrameFigures;
end;
RefreshCAD(aCad.PCad);
FSCS_Main.SaveStamp(FullPathName);
aCad.PCad.DeselectAll(0);
aCad.PCad.SelectAll(7);
aCad.PCad.RemoveSelection;
RefreshCAD(aCad.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.RemoveFrameFromList', E.Message);
end;
end;
procedure LoadCaptionsOnFrame(ACAD: TF_CAD; AStampType: TStampType; ACreateForLack: Boolean=true; AEnabledCaptions: TintList=nil);
var
aProjectName: string;
aListName: string;
aCodeName: string;
aIndexName: string;
LHandle: Integer;
aBnd: TDoubleRect;
aTextWidth, aTextHeight: Double;
aPoint: TDoublePoint;
deltax, deltay: double;
TextObject: TFigure;
_TextX, _TextY: double;
ProjParams: TProjectParams;
ListParams: TListParams;
i: integer;
FrameFigure: TFigure;
FrameFigureCode: Integer;
procedure ReCreateDeveloper;
begin
// Ðàçðàáîòàë
//aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FCadStampMargins.Right - 185.5; //14.11.2011 - 5 - 120;
//aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FCadStampMargins.Right - 135.5; //14.11.2011 - 5 - 50;
//aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FCadStampMargins.Bottom - 34.5; //14.11.2011 - 5 - 30;
//aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FCadStampMargins.Bottom - 19.5; //14.11.2011 - 5 - 15;
aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 164.5; //14.11.2011 - 5 - 120;
aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 104.5; //14.11.2011 - 5 - 50;
aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 32; //14.11.2011 - 5 - 30;
aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 22; //14.11.2011 - 5 - 15;
ACAD.FFrameStampDeveloper := ReCreateStampCaptionToField(ACAD, ACAD.FFrameStampDeveloper, ftDeveloperName, aBnd, ACAD.FStampFields.Developer, ACreateForLack, AEnabledCaptions, false, 10);
end;
//03.10.2012
procedure ReCreateChecker;
begin
// Ïðîâåðèë
aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 164.5; //14.11.2011 - 5 - 120;
aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 104.5; //14.11.2011 - 5 - 50;
aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 27; //14.11.2011 - 5 - 30;
aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 17; //14.11.2011 - 5 - 15;
ACAD.FFrameStampChecker := ReCreateStampCaptionToField(ACAD, ACAD.FFrameStampChecker, ftCheckerName, aBnd, ACAD.FStampFields.Checker, ACreateForLack, AEnabledCaptions, false, 10);
end;
procedure ReCreateMainEngineer;
begin
// Ãëàâíûé èíæåíåð ïðîåêòà
aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 164.5;
aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 104.5;
aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 22;
aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 12;
ReCreateStampCaptionToField(ACAD, nil, ftMainEngineer, aBnd, ACAD.FStampFields.MainEngineer, ACreateForLack, AEnabledCaptions, false, 10);
end;
procedure ReCreateApproved;
begin
// Óòâåðäèë
aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 164.5;
aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 104.5;
aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 12;
aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 2;
ReCreateStampCaptionToField(ACAD, nil, ftApproved, aBnd, ACAD.FStampFields.Approved, ACreateForLack, AEnabledCaptions, false, 10);
end;
procedure ReCreateDesignStage;
begin
// Ñòàäèÿ ïðîåêòèð
aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 20 - 30;
aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 20 - 15;
aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 15 - 10;
aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 15;
ReCreateStampCaptionToField(ACAD, nil, ftDesignStage, aBnd, ACAD.FStampFields.DesignStage, ACreateForLack, AEnabledCaptions, true, 12);
end;
procedure ReCreateListDescription;
var
aListDescription: String;
begin
aListDescription := '';
if ListParams.Settings.ListType <> lt_Normal then
begin
case ListParams.Settings.ListType of
lt_DesignBox:
if ListParams.Settings.CADStampLang in [stl_ukr, stl_ukr_dstu] then
aListDescription := cCommon_Mes25_ukr
else
aListDescription := cCommon_Mes25;
lt_ProjectPlan:
if ListParams.Settings.CADStampLang in [stl_ukr, stl_ukr_dstu] then
aListDescription := cCommon_Mes26_ukr
else
aListDescription := cCommon_Mes26;
end;
end;
// Îïèñàíèå ïðåíàäëåæíîñòè ëèñòà
aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 119;
aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 50;
aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 15 - 1;
aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 1;
ReCreateStampCaptionToField(ACAD, nil, ftListDescription, aBnd, aListDescription, ACreateForLack, nil, true, 13);
end;
procedure ReCreateFillFields;
begin
// Ðàçðàáîòàë
ReCreateDeveloper;
// Ïðîâåðèë
ReCreateChecker;
// Ãëàâíûé èíæåíåð ïðîåêòà
ReCreateMainEngineer;
// Óòâåðäèë
ReCreateApproved;
// Ñòàäèÿ ïðîåêòèð
ReCreateDesignStage;
// Îïèñàíèå ïðåíàäëåæíîñòè ëèñòà
ReCreateListDescription;
end;
begin
ACAD.PCad.DisableAlign;
try
ProjParams := GetCurrProjectParams(false);
aProjectName := ProjParams.Caption;
ListParams := GetListParams(ACAD.FCADListID);
aListName := ListParams.Name;
if ACAD.FStampFields.ListSign <> '' then
aListName := ACAD.FStampFields.ListSign;
aCodeName := ListParams.Name;
aIndexName := IntToStr(ListParams.MarkID);
LHandle := ACAD.PCad.GetLayerHandle(7);
// ÏÐÎÑÒÎÉ
if AStampType = stt_simple then
begin
// íîìåð ëèñòà
aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 10; //14.11.2011 5 - 10;
aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right; //14.11.2011 5;
aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 8; //14.11.2011 - 5 - 8;
aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom; //14.11.2011 - 5;
//13.09.2010
//if GCadForm.FFrameIndexName = nil then
//begin
// if ACreateForLack then
// begin
// GCadForm.FFrameIndexName := CreateStampCaptionToField(aBnd, aIndexName);
// GCadForm.FFrameIndexName.DataID := 400;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameIndexName, False);
// end;
//end
//else
//begin
// GCadForm.PCad.Figures.Remove(GCadForm.FFrameIndexName);
// RefreshCad(GCadForm.PCad);
// GCadForm.FFrameIndexName := CreateStampCaptionToField(aBnd, aIndexName);
// GCadForm.FFrameIndexName.DataID := 400;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameIndexName, False);
//end;
ACAD.FFrameIndexName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameIndexName, 400, aBnd, aIndexName, ACreateForLack, AEnabledCaptions);
// ëèñò
aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 120; //14.11.2011 - 5 - 120;
aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 10; //14.11.2011 - 5 - 10;
aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 15; //14.11.2011 - 5 - 15;
aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom; //14.11.2011 - 5;
//13.09.2010
//if GCadForm.FFrameListName = nil then
//begin
// if ACreateForLack then
// begin
// GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName);
// GCadForm.FFrameListName.DataID := 200;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameListName, False);
// end;
//end
//else
//begin
// GCadForm.PCad.Figures.Remove(GCadForm.FFrameListName);
// RefreshCad(GCadForm.PCad);
// GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName);
// GCadForm.FFrameListName.DataID := 200;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameListName, False);
//end;
ACAD.FFrameListName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameListName, 200, aBnd, aListName, ACreateForLack, AEnabledCaptions);
end;
// ÐÀÑØÈÐÅÍÍÛÉ
if AStampType = stt_extended then
begin
// íîìåð ëèñòà
aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 20 - 15; //14.11.2011 - 5 - 20 - 15;
aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 20; //14.11.2011 - 5 - 20;
aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 15 - 10; //14.11.2011 - 5 - 15 - 10;
aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 15; //14.11.2011 - 5 - 15;
//13.09.2010
//if GCadForm.FFrameIndexName = nil then
//begin
// if ACreateForLack then
// begin
// GCadForm.FFrameIndexName := CreateStampCaptionToField(aBnd, aIndexName);
// GCadForm.FFrameIndexName.DataID := 400;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameIndexName, False);
// end;
//end
//else
//begin
// GCadForm.PCad.Figures.Remove(GCadForm.FFrameIndexName);
// RefreshCad(GCadForm.PCad);
// GCadForm.FFrameIndexName := CreateStampCaptionToField(aBnd, aIndexName);
// GCadForm.FFrameIndexName.DataID := 400;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameIndexName, False);
//end;
ACAD.FFrameIndexName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameIndexName, 400, aBnd, aIndexName, ACreateForLack, AEnabledCaptions);
// ëèñò
aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 120; //14.11.2011 - 5 - 120;
aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right; //14.11.2011 - 5;
aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 45; //14.11.2011 - 5 - 45;
aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 30; //14.11.2011 - 5 - 30;
//13.09.2010
//if GCadForm.FFrameListName = nil then
//begin
// if ACreateForLack then
// begin
// GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName);
// GCadForm.FFrameListName.DataID := 200;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameListName, False);
// end;
//end
//else
//begin
// GCadForm.PCad.Figures.Remove(GCadForm.FFrameListName);
// RefreshCad(GCadForm.PCad);
// GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName);
// GCadForm.FFrameListName.DataID := 200;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameListName, False);
//end;
//18.11.2011 ACAD.FFrameListName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameListName, 200, aBnd, aListName, ACreateForLack, AEnabledCaptions);
ACAD.FFrameListName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameListName, 200, aBnd, aListName, ACreateForLack, AEnabledCaptions);
// ïðîåêò
aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 120; //14.11.2011 - 5 - 120;
aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 50; //14.11.2011 - 5 - 50;
aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 30; //14.11.2011 - 5 - 30;
aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 15; //14.11.2011 - 5 - 15;
//13.09.2010
//if GCadForm.FFrameProjectName = nil then
//begin
// if ACreateForLack then
// begin
// GCadForm.FFrameProjectName := CreateStampCaptionToField(aBnd, aProjectName);
// GCadForm.FFrameProjectName.DataID := 100;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameProjectName, False);
// end;
//end
//else
//begin
// GCadForm.PCad.Figures.Remove(GCadForm.FFrameProjectName);
// RefreshCad(GCadForm.PCad);
// GCadForm.FFrameProjectName := CreateStampCaptionToField(aBnd, aProjectName);
// GCadForm.FFrameProjectName.DataID := 100;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameProjectName, False);
//end;
ACAD.FFrameProjectName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameProjectName, 100, aBnd, aProjectName, ACreateForLack, AEnabledCaptions);
// Çàïîëíÿåìûå ïîëÿ ðàìêè
ReCreateFillFields;
end;
// ÏÎÄÐÎÁÍÛÉ
if AStampType = stt_detailed then
begin
// íîìåð ëèñòà
aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 20 - 15; //14.11.2011 - 5 - 20 - 15;
aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 20; //14.11.2011 - 5 - 20;
aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 15 - 10; //14.11.2011 - 5 - 15 - 10;
aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 15; //14.11.2011 - 5 - 15;
//13.09.2010
//if GCadForm.FFrameIndexName = nil then
//begin
// if ACreateForLack then
// begin
// GCadForm.FFrameIndexName := CreateStampCaptionToField(aBnd, aIndexName);
// GCadForm.FFrameIndexName.DataID := 400;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameIndexName, False);
// end;
//end
//else
//begin
// GCadForm.PCad.Figures.Remove(GCadForm.FFrameIndexName);
// RefreshCad(GCadForm.PCad);
// GCadForm.FFrameIndexName := CreateStampCaptionToField(aBnd, aIndexName);
// GCadForm.FFrameIndexName.DataID := 400;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameIndexName, False);
//end;
ACAD.FFrameIndexName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameIndexName, 400, aBnd, aIndexName, ACreateForLack, AEnabledCaptions);
// ëèñò
aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 120; //14.11.2011 - 5 - 120;
aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right; //14.11.2011 - 5;
aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 55; //14.11.2011 - 5 - 55;
aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 45; //14.11.2011 - 5 - 45;
//13.09.2010
//if GCadForm.FFrameListName = nil then
//begin
// if ACreateForLack then
// begin
// GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName);
// GCadForm.FFrameListName.DataID := 200;
// GCadForm.PCad.AddCustomFigure(GLN(LHandle), GCadForm.FFrameListName, False);
// end;
//end
//else
//begin
// GCadForm.PCad.Figures.Remove(GCadForm.FFrameListName);
// RefreshCad(GCadForm.PCad);
// GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName);
// GCadForm.FFrameListName.DataID := 200;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameListName, False);
//end;
ACAD.FFrameListName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameListName, 200, aBnd, aListName, ACreateForLack, AEnabledCaptions);
// Îðãàíèçàöèÿ
aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 119;
aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right;
aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 45;
aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 30;
ReCreateStampCaptionToField(ACAD, nil, ftOrgName, aBnd, ProjParams.Setting.OrganizationName, ACreateForLack, AEnabledCaptions);
// ïðîåêò
//03.10.2012 - äíà ýòîì ìåñòå òåïåðü íàçâàíèå îðãàíèçàöèè
//aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 120; //14.11.2011 - 5 - 120;
//aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right; //14.11.2011 - 5;
//aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 45; //14.11.2011 - 5 - 45;
//aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 30; //14.11.2011 - 5 - 30;
aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 119;
aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 50;
aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 30;
aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 15;
//13.09.2010
//if GCadForm.FFrameProjectName = nil then
//begin
// if ACreateForLack then
// begin
// GCadForm.FFrameProjectName := CreateStampCaptionToField(aBnd, aProjectName);
// GCadForm.FFrameProjectName.DataID := 100;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameProjectName, False);
// end;
//end
//else
//begin
// GCadForm.PCad.Figures.Remove(GCadForm.FFrameProjectName);
// RefreshCad(GCadForm.PCad);
// GCadForm.FFrameProjectName := CreateStampCaptionToField(aBnd, aProjectName);
// GCadForm.FFrameProjectName.DataID := 100;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameProjectName, False);
//end;
ACAD.FFrameProjectName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameProjectName, 100, aBnd, aProjectName, ACreateForLack, AEnabledCaptions);
// Çàïîëíÿåìûå ïîëÿ ðàìêè
ReCreateFillFields;
end;
// øòàìï â âåðõíåì óãëó
aBnd.Left := ACAD.FStampFields.Margins.Left; //14.11.2011 20;
aBnd.Top := ACAD.FStampFields.Margins.Top; //14.11.2011 5;
aBnd.Right := ACAD.FStampFields.Margins.Left + 70; //14.11.2011 20 + 70;
aBnd.Bottom := ACAD.FStampFields.Margins.Top + 15; //14.11.2011 5 + 15;
//13.09.2010
//if GCadForm.FFrameCodeName = nil then
//begin
// if ACreateForLack then
// begin
// GCadForm.FFrameCodeName := CreateStampCaptionToField(aBnd, aCodeName);
// GCadForm.FFrameCodeName.DataID := 300;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameCodeName, False);
// GCadForm.FFrameCodeName.rotate(pi, GCadForm.FFrameCodeName.CenterPoint);
// end;
//end
//else
//begin
// GCadForm.PCad.Figures.Remove(GCadForm.FFrameCodeName);
// RefreshCad(GCadForm.PCad);
// GCadForm.FFrameCodeName := CreateStampCaptionToField(aBnd, aCodeName);
// GCadForm.FFrameCodeName.DataID := 300;
// GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameCodeName, False);
// GCadForm.FFrameCodeName.rotate(pi, GCadForm.FFrameCodeName.CenterPoint);
//end;
//18.11.2011 ACAD.FFrameCodeName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameCodeName, 300, aBnd, aCodeName, ACreateForLack, AEnabledCaptions);
ACAD.FFrameCodeName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameCodeName, 300, aBnd, aCodeName+' '+aIndexName, ACreateForLack, AEnabledCaptions);
if ACAD.FFrameCodeName <> nil then
ACAD.FFrameCodeName.rotate(pi, ACAD.FFrameCodeName.CenterPoint);
// âûñòàâèòü âèçèáë/èíâèçèáë ïîäïèñåé
{//17.11.2011
if ACAD.FFrameProjectName <> nil then
ACAD.FFrameProjectName.Visible := ACAD.FShowMainStamp;
if ACAD.FFrameListName <> nil then
ACAD.FFrameListName.Visible := ACAD.FShowMainStamp;
if ACAD.FFrameCodeName <> nil then
ACAD.FFrameCodeName.Visible := ACAD.FShowUpperStamp;
if ACAD.FFrameIndexName <> nil then
ACAD.FFrameIndexName.Visible := ACAD.FShowMainStamp;}
for i := 0 to ACad.FFrameObjects.Count - 1 do
begin
FrameFigure := TFigure(ACad.FFrameObjects.Objects[i]);
FrameFigureCode := StrToint(ACad.FFrameObjects[i]);
if (FrameFigure <> nil) then
begin
if (FrameFigureCode <> ftCodeName) then
FrameFigure.Visible := GCadForm.FShowMainStamp
else
FrameFigure.Visible := ACAD.FShowUpperStamp;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.LoadCaptionsOnFrame', E.Message);
end;
ACAD.PCad.EnableAlign;
end;
function CreateStampCaptionToField(ACAD: TF_CAD; aFieldBnd: TDoubleRect; const aText: String;
ATextHorzCenter: Boolean=true; ATextSize: Integer=14): TRichText;
var
i, k: integer;
LHandle: Integer;
TextField: TRichText;
FieldCP: TDoublePoint;
TM: TTextMetric;
xCanvas: TMetafileCanvas;
h, w: double;
resh, resw: double;
HalfField: double;
HalfText: double;
ModCount: Integer;
TextSize: Integer;
TextStyle: TFontStyles;
delta: double;
textx, texty: double;
begin
Result := nil;
try
// if aText = 'Ëèñò 1' then
// aText := 'iopfgipoed_doiepoefep_efpmep9fkepfiepf_efkepfie0fi0efn_f0efi[0e0fe_epfke0[pfie0f_fmpekfpefke_efjepfjpef_epfjepofjepojfe_ejfepofkopef_lefjepjfpeojfe_elfmepfkekfpeof_emfepfkjepfkoe_felmfepofkjpoefe,_flemfpemfpemnfpe_flefmepf_epof';
delta := 0;
textx := abs(aFieldBnd.Right - aFieldBnd.Left);
texty := abs(aFieldBnd.Bottom - aFieldBnd.Top);
TextStyle := [];
LHandle := ACAD.PCad.GetLayerHandle(2);
FieldCP.x := (aFieldBnd.Left + aFieldBnd.Right) / 2;
FieldCP.y := (aFieldBnd.Top + aFieldBnd.Bottom) / 2;
w := 0; //#From Oleg# //14.09.2010
h := 0; //#From Oleg# //14.09.2010
TextSize := 1; //#From Oleg# //14.09.2010
k := ATextSize; //17.11.2011 14;
while k >= 1 do
begin
TextSize := k;
TextField := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone,
LHandle, mydsNormal, ACAD.PCad);
TextField.re.WordWrap := False;
TextField.re.Font.Name := ACAD.FFontName;
TextField.re.Font.Size := TextSize;
TextField.re.Font.Style := TextStyle;
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);
h := TM.tmHeight / 4;
w := xCanvas.TextWidth(TextField.Re.Lines[0]);
w := (w + 3) / 4;
FreeAndNil(xCanvas);
if TextField <> nil then
FreeAndNil(TextField);
// òåêñò âïèñûâàåòñÿ â ãðàíèöû
if (w * h) < (textx * texty - 50) then
begin
Break;
end;
k := k - 1;
end;
// êîíòðîëü ïî øèðèíå
// íå áîëüøå ÷åì øèðèíà âïèñóåìîãî ïîëÿ
if textx > w then
resw := w
else
resw := textx;
// âû÷èñëèòü âûñîòó èñõîäÿ èç ïåðåíîñîâ ñòðîê
{ //18.11.2011
if textx > w then
h := h * (Round(w / textx) + 1)
else
h := h * (Round(w / textx) + 1) + 1;}
if textx > w then
h := h * RoundUp(w / textx)
else
h := h * RoundUp(w / textx) + 1;
// êîíòðîëü ïî âûñîòå
// íåáîëüøå ÷åì âûñîòà âïèñóåìîãî ïîëÿ
if texty > h then
resh := h
else
resh := texty;
TextField := TRichText.create(-100, -100, -100 + resw, -100 + resh, 1, ord(psSolid), clBlack, ord(bsClear), clNone,
LHandle, mydsNormal, ACAD.PCad);
TextField.re.WordWrap := True;
TextField.re.Font.Name := ACAD.FFontName;
TextField.re.Font.Size := TextSize;
TextField.re.Font.Style := TextStyle;
TextField.re.Font.Color := clBlack;
TextField.re.Lines.Clear;
TextField.re.Lines.Add(aText);
if ATextHorzCenter then
TextField.Move(FieldCP.x - TextField.CenterPoint.x, (FieldCP.y - TextField.CenterPoint.y) + delta)
else
TextField.Move(aFieldBnd.Left - TextField.ap1.x, (FieldCP.y - TextField.CenterPoint.y) + delta);
Result := TextField;
except
on E: Exception do addExceptionToLogEx('U_Common.CreateStampCaptionToField', E.Message);
end;
end;
function ReCreateStampCaptionToField(ACAD: TF_CAD; ACurrStampField: TRichText; ADataID: Integer; aFieldBnd: TDoubleRect; const aText: String;
ACreateForLack: Boolean=true; AEnabledCaptions: TintList=nil; ATextHorzCenter: Boolean=true; ATextSize: Integer=14): TRichText;
var
//CAD: TF_CAD;
LHandle: Integer;
ObjIdx: Integer;
begin
result := nil;
try
if ACurrStampField <> nil then
if ACurrStampField.ClassName <> 'TRichText' then
ACurrStampField := nil;
if ACurrStampField = nil then
begin
ObjIdx := ACAD.FFrameObjects.IndexOf(IntToStr(ADataID));
if ObjIdx <> -1 then
ACurrStampField := TRichText(ACAD.FFrameObjects.Objects[ObjIdx]);
end;
if ACurrStampField <> nil then
if ACurrStampField.ClassName <> 'TRichText' then
ACurrStampField := nil;
Result := ACurrStampField;
if (AEnabledCaptions = nil) or (AEnabledCaptions.IndexOf(ADataID) <> -1) then
begin
if ACurrStampField = nil then
begin
if ACreateForLack then
begin
Result := CreateStampCaptionToField(ACAD, aFieldBnd, aText, ATextHorzCenter, ATextSize);
//CAD := TF_CAD(Result.Owner.Owner);
Result.DataID := ADataID;
LHandle := ACAD.PCad.GetLayerHandle(7);
ACAD.PCad.AddCustomFigure (GLN(LHandle), Result, False);
end;
end
else
begin
//CAD := TF_CAD(ACurrStampField.Owner.Owner);
if ACurrStampField.ClassName = 'TRichText' then
begin
ACAD.PCad.Figures.Remove(ACurrStampField);
FreeAndNil(ACurrStampField);
end
else
begin
exit;
end;
RefreshCad(ACAD.PCad);
Result := CreateStampCaptionToField(ACAD, aFieldBnd, aText, ATextHorzCenter, ATextSize);
Result.DataID := ADataID;
LHandle := ACAD.PCad.GetLayerHandle(7);
ACAD.PCad.AddCustomFigure (GLN(LHandle), Result, False);
end;
if Result <> nil then
begin
ObjIdx := ACAD.FFrameObjects.IndexOf(IntToStr(ADataID));
if ObjIdx <> -1 then
ACAD.FFrameObjects.Objects[ObjIdx] := Result;
end;
end;
except
end;
end;
function GetFileNameFromFullPath(aFullPath: string): string;
var
i, j: integer;
strlen: integer;
fName: string;
begin
try
strlen := Length(aFullPath);
for i := strlen - 1 downto 0 do
begin
if aFullPath[i] = '\' then
break;
end;
j := 0;
SetLength(fName, 0);
SetLength(fName, strlen - i);
while i <= strlen do
begin
fName[j] := aFullPath[i];
i := i + 1;
j := j + 1;
end;
Result := fName;
except
on E: Exception do addExceptionToLogEx('U_Common.GetFileNameFromFullPath', E.Message);
end;
end;
procedure GetConnObjectsByLine(AIDList, AIDLine: Integer; var AConnAtSide1: Integer; var AConnAtSide2: Integer);
var
FCAD: TF_CAD;
FLine: TOrthoLine;
JoinedConn1, JoinedConn2: TConnectorObject;
begin
try
AConnAtSide1 := -1;
AConnAtSide2 := -1;
FCAD := GetListByID(AIDList);
if FCAD <> nil then
begin
FLine := TOrthoLine(GetFigureByID(FCAD, AIDLine));
if FLine <> nil then
begin
JoinedConn1 := TConnectorObject(FLine.JoinConnector1);
JoinedConn2 := TConnectorObject(FLine.JoinConnector2);
if JoinedConn1.JoinedConnectorsList.Count > 0 then
begin
if TConnectorObject(JoinedConn1.JoinedConnectorsList[0]).ConnectorType <> ct_Clear then
begin
if TConnectorObject(JoinedConn1.JoinedConnectorsList[0]).FIsApproach then
AConnAtSide1 := TConnectorObject(JoinedConn1.JoinedConnectorsList[0]).FHouse.ID
else
AConnAtSide1 := TConnectorObject(JoinedConn1.JoinedConnectorsList[0]).ID;
end;
end
else
begin
if JoinedConn1.FIsHouseJoined then
if JoinedConn1.FHouse <> nil then
AConnAtSide1 := JoinedConn1.FHouse.ID;
end;
if JoinedConn2.JoinedConnectorsList.Count > 0 then
begin
if TConnectorObject(JoinedConn2.JoinedConnectorsList[0]).ConnectorType <> ct_Clear then
begin
if TConnectorObject(JoinedConn2.JoinedConnectorsList[0]).FIsApproach then
AConnAtSide2 := TConnectorObject(JoinedConn2.JoinedConnectorsList[0]).FHouse.ID
else
AConnAtSide2 := TConnectorObject(JoinedConn2.JoinedConnectorsList[0]).ID;
end;
end
else
begin
if JoinedConn2.FIsHouseJoined then
if JoinedConn2.FHouse <> nil then
AConnAtSide2 := JoinedConn2.FHouse.ID;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetConnObjectsByLine', E.Message);
end;
end;
procedure RenameProjectOnFrame(AOldProjParams: TProjectParams);
var
i: integer;
CurForm: TF_CAD;
begin
try
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
CurForm := TF_CAD(FSCS_Main.MDIChildren[i]);
//if (TRichText(GCadForm.FFrameListName).re.Text = '') then
// RenameListOnFrame(CurForm, ProjParams, GetListParams(CurForm.FCADListID));
RenameListOnFrame(CurForm, AOldProjParams, GetListParams(CurForm.FCADListID));
RefreshCAD(CurForm.PCad);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.RenameProjectOnFrame', E.Message);
end;
end;
procedure RenameListOnFrame(ACadForm: TF_CAD; AOldProjParams: TProjectParams; AOldListParams: TListParams);
var
i: integer;
Figure: TRichText;
FigureCode: Integer;
CmpText: String;
FrameFig: TFrame;
EnabledCaptions: TintList;
function CheckRichTextCaption(AObject: TRichText; const ACaption: String): Boolean;
var
reText: String;
i: Integer;
begin
//Result := (AObject <> nil) and (AObject.re <> nil) and (AObject.re.Lines.Count = 1) and (AObject.re.Lines[0] = ACaption);
Result := (AObject <> nil) and (AObject.re <> nil);
if Result then
begin
reText := '';
for i := 0 to AObject.re.Lines.Count - 1 do
reText := reText + AObject.re.Lines[i];
Result := reText = ACaption;
end;
end;
begin
try
//13.09.2010
//if ((GCadForm.FFrameProjectName = nil) or (GCadForm.FFrameProjectName.re.Text = '')) or
// ((GCadForm.FFrameListName = nil) or (GCadForm.FFrameListName.re.Text = '')) then
//begin
// LoadCaptionsOnFrame(ACadForm.FCadStampType);
// RefreshCAD(ACadForm.PCad);
//end;
EnabledCaptions := TintList.Create;
{//17.11.2011
// íîìåð ëèñòà
if CheckRichTextCaption(ACadForm.FFrameIndexName, IntToStr(AOldListParams.MarkID)) then
EnabledCaptions.Add(400);
// øòàìï â âåðõíåì óãëó
if CheckRichTextCaption(ACadForm.FFrameCodeName, AOldListParams.Name) then
EnabledCaptions.Add(300);
// ëèñò
if CheckRichTextCaption(ACadForm.FFrameListName, AOldListParams.Name) then
EnabledCaptions.Add(200);
// ïðîåêò
if CheckRichTextCaption(ACadForm.FFrameProjectName, AOldProjParams.Caption) then
EnabledCaptions.Add(100);}
for i := 0 to ACadForm.FFrameObjects.Count - 1 do
begin
Figure := TRichText(ACadForm.FFrameObjects.Objects[i]);
if Figure <> nil then
begin
FigureCode := StrToInt(ACadForm.FFrameObjects[i]);
CmpText := '';
case FigureCode of
ftProjectName:
CmpText := AOldProjParams.Caption;
ftOrgName:
CmpText := AOldProjParams.Setting.OrganizationName;
ftListName:
begin
if AOldListParams.Settings.CADStampListSign <> '' then
CmpText := AOldListParams.Settings.CADStampListSign
else
CmpText := AOldListParams.Name;
end;
ftCodeName:
CmpText := AOldListParams.Name +' '+ IntToStr(AOldListParams.MarkID); //18.11.2011 AOldListParams.Name;
ftIndexName:
CmpText := IntToStr(AOldListParams.MarkID);
ftDeveloperName:
CmpText := AOldListParams.Settings.CADStampDeveloper;
ftCheckerName:
CmpText := AOldListParams.Settings.CADStampChecker;
ftMainEngineer:
CmpText := AOldListParams.Settings.CADStampMainEngineer;
ftApproved:
CmpText := AOldListParams.Settings.CADStampApproved;
ftDesignStage:
CmpText := AOldListParams.Settings.CADStampDesignStage;
end;
if CheckRichTextCaption(Figure, CmpText) then
EnabledCaptions.Add(FigureCode);
end;
end;
if EnabledCaptions.Count > 0 then
LoadCaptionsOnFrame(ACadForm, ACadForm.FCadStampType, false, EnabledCaptions);
EnabledCaptions.Free;
except
on E: Exception do addExceptionToLogEx('U_Common.RenameListOnFrame', E.Message);
end;
end;
function CheckByBreakConnector(aClearConn, aPointObject: TConnectorObject): Boolean;
var
CheckedX, CheckedY: Double;
MinX, MinY, MaxX, MaxY: Double;
i: integer;
Step: Double;
begin
Result := False;
try
Step := GCadForm.PCad.GridStep;
CheckedX := aClearConn.ActualPoints[1].x;
CheckedY := aClearConn.ActualPoints[1].y;
if (not APointObject.FDrawFigureMoved)and(APointObject.FDrawFigureAngle = 0) then
if not HaveObjectSocketComponent(APointObject.ID) then
begin
MinX := (aPointObject.ActualPoints[1].x - aPointObject.GrpSizeX / 2) - 0.1;
MinY := (aPointObject.ActualPoints[1].y - aPointObject.GrpSizeY / 2) - 0.1;
MaxX := (aPointObject.ActualPoints[1].x + aPointObject.GrpSizeX / 2) + 0.1;
MaxY := (aPointObject.ActualPoints[1].y + aPointObject.GrpSizeY / 2) + 0.1;
end
else //Åñëè êîíåêòîð íå ïî öåíòðó ôèãóðû
begin
MinX := (aPointObject.ActualPoints[1].x) - 0.1;
MinY := (aPointObject.ActualPoints[1].y - aPointObject.GrpSizeY / 2) - 0.1;
MaxX := (aPointObject.ActualPoints[1].x + aPointObject.GrpSizeX) + 0.1;
MaxY := (aPointObject.ActualPoints[1].y + aPointObject.GrpSizeY / 2) + 0.1;
end
else
//À ýòîò êóñî÷åê íóæåí åñëè ôèãóðà ñäâèíóòà èëè ïîâåðíóòà íà óãîë
begin
MinX := aPointObject.DrawFigure.GetBoundRect.Left - 0.1;
MinY := aPointObject.DrawFigure.GetBoundRect.Top - 0.1;
MaxX := aPointObject.DrawFigure.GetBoundRect.Right + 0.1;
MaxY := aPointObject.DrawFigure.GetBoundRect.Bottom + 0.1;
end;
if GCadForm.PCad.SnapToGrids then
begin
MinX := Trunc(MinX / Step) * Step;
MinY := Trunc(MinY / Step) * Step;
MaxX := Trunc(MaxX / Step) * Step + Step;
MaxY := Trunc(MaxY / Step) * Step + Step;
end;
if (CheckedX < MinX) or (CheckedX > MaxX) or (CheckedY < MinY) or (CheckedY > MaxY) then
Result := True;
except
on E: Exception do addExceptionToLogEx('CheckByBreakConnector', E.Message);
end;
end;
function CheckByBreakConnectorByCoords(aConnPoints: TDoublePoint; aPointObject: TConnectorObject): Boolean;
var
CheckedX, CheckedY: Double;
MinX, MinY, MaxX, MaxY: Double;
i: integer;
Step: Double;
begin
Result := False;
try
Step := GCadForm.PCad.GridStep;
CheckedX := aConnPoints.x;
CheckedY := aConnPoints.y;
MinX := (aPointObject.ActualPoints[1].x - aPointObject.GrpSizeX / 2) - 0.1;
MinY := (aPointObject.ActualPoints[1].y - aPointObject.GrpSizeY / 2) - 0.1;
MaxX := (aPointObject.ActualPoints[1].x + aPointObject.GrpSizeX / 2) + 0.1;
MaxY := (aPointObject.ActualPoints[1].y + aPointObject.GrpSizeY / 2) + 0.1;
if GCadForm.PCad.SnapToGrids then
begin
MinX := Trunc(MinX / Step) * Step;
MinY := Trunc(MinY / Step) * Step;
MaxX := Trunc(MaxX / Step) * Step + Step;
MaxY := Trunc(MaxY / Step) * Step + Step;
end;
if (CheckedX < MinX) or (CheckedX > MaxX) or (CheckedY < MinY) or (CheckedY > MaxY) then
Result := True;
except
on E: Exception do addExceptionToLogEx('CheckByBreakConnectorByCoords', E.Message);
end;
end;
procedure RefreshCAD_T(aPCAD: TPowerCad; AExecPrev: Boolean=false);
begin
if AExecPrev and Assigned(GRefreshCad) and FSCS_Main.TimerRefresh.Enabled and Assigned(FSCS_Main.TimerRefresh.OnTimer) then
FSCS_Main.TimerRefresh.OnTimer(FSCS_Main.TimerRefresh);
GRefreshCad := aPCAD;
FSCS_Main.TimerRefresh.Enabled := True;
end;
procedure RefreshCADs(aCADs: TList);
var
i: Integer;
begin
for i := 0 to aCADs.Count - 1 do
RefreshCAD(TF_CAD(aCADs[i]).PCad);
end;
procedure RefreshCAD(aPCAD: TPowerCad);
begin
try
if aPCAD <> nil then
aPCAD.Refresh;
except
on E: Exception do addExceptionToLogEx(cCommon_Mes13, E.Message);
end;
end;
procedure ProcessMessagesEx;
function IsKeyMsg(var Msg: TMsg): Boolean;
const
CN_BASE = $BC00;
var
Wnd: HWND;
begin
Result := False;
with Msg do
if (Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST) then
begin
Wnd := GetCapture;
if Wnd = 0 then
begin
Wnd := HWnd;
if SendMessage(Wnd, CN_BASE + Message, WParam, LParam) <> 0 then
Result := True;
end
else
if (LongWord(GetWindowLong(Wnd, GWL_HINSTANCE)) = HInstance) then
if SendMessage(Wnd, CN_BASE + Message, WParam, LParam) <> 0 then
Result := True;
end;
end;
function ProcessMessage(var Msg: TMsg): Boolean;
begin
Result := False;
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
begin
Result := True;
if ((Msg.message > WM_MOUSEFIRST) and (Msg.message > WM_MOUSELAST)) or (Msg.message = WM_PAINT) then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
end;
{function ProcessMessage(var Msg: TMsg): Boolean;
var
HandledMsg: Boolean;
begin
Result := False;
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
begin
Result := True;
HandledMsg := False;
if Assigned(Application.OnMessage) then
Application.OnMessage(Msg, HandledMsg);
if Not HandledMsg then
if ((Msg.message >= WM_MOUSEFIRST) and (Msg.message <= WM_MOUSELAST)) or
(Msg.message = WM_PAINT) or (Msg.message <= WM_TIMER) then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
end;}
var
Msg: TMsg;
begin
while ProcessMessage(Msg) do {loop};
//Application.ProcessMessages;
end;
procedure ReDrawCurrShadowOnCAD;
begin
try
if (GCadForm <> nil) and (GCadForm.PCad <> nil) and (FSCS_Main.MDIChildCount > 0) then
begin
if ((GCadForm.PCad.ToolIdx = toFigure) and (GCadForm.PCad.ToolInfo = 'TOrthoLine')) and (GClickIndex > 0) then
begin
GCadForm.PCad.Refresh;
GCadForm.PCad.Repaint;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.aReDrawCurrCAD', E.Message);
end;
end;
procedure UnSelectFiguresOnSelectedChange(aSelectedList: TList);
var
i: integer;
CurrFigure: TFigure;
CurrConn: TConnectorObject;
CurrLine: TOrthoLine;
ObjFromRaise: TConnectorObject;
begin
try
// 1. óáðàòü âûäåëåíèå ñ ïðèñîåäèíåííûõ ñîåäèíèòåëåé ëèíèé
// 2. óáèðàòü âûäåëåíèå ñ ñ-ï åñëè âûäåëåíà ÐÒ íà êîòîðîé ñ-ï
for i := 0 to aSelectedList.Count - 1 do
begin
CurrFigure := TFigure(aSelectedList[i]);
if CheckFigureByClassName(CurrFigure, cTConnectorObject) then
begin
CurrConn := TConnectorObject(CurrFigure);
// âåðøèíà ñ-ï
if CurrConn.FConnRaiseType <> crt_None then
begin
// òîëüêî åñëè âåðøèíà ñ-ï - ïóñòîé ñîåäèíèòåëü
if CurrConn.ConnectorType = ct_Clear then
begin
ObjFromRaise := CurrConn.FObjectFromRaise;
if ObjFromRaise <> nil then
if not CheckNoFigureInList(ObjFromRaise, aSelectedList) then
CurrConn.Deselect;
end;
end;
end;
if CheckFigureByClassName(CurrFigure, cTOrthoLine) then
begin
CurrLine := TOrthoLine(CurrFigure);
// ïðèñîåäèíåííûå êîííåêòîðû ëèíèè
// if not CheckNoFigureInList(CurrLine.JoinConnector1, aSelectedList) then
// CurrLine.JoinConnector1.Deselect;
// if not CheckNoFigureInList(CurrLine.JoinConnector2, aSelectedList) then
// CurrLine.JoinConnector2.Deselect;
if CurrLine.FIsRaiseUpDown then
begin
ObjFromRaise := CurrLine.FObjectFromRaisedLine;
if ObjFromRaise <> nil then
if not CheckNoFigureInList(ObjFromRaise, aSelectedList) then
CurrLine.Deselect;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('UnSelectFiguresOnSelectedChange', E.Message);
end;
end;
procedure ReCalcAllLinesLength;
var
i: integer;
CurrLine: TOrthoLine;
begin
try
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then
begin
CurrLine := TOrthoLine(GCadForm.PCad.Figures[i]);
if not CurrLine.FIsRaiseUpDown then
begin
CurrLine.CalculLength := CurrLine.LengthCalc;
CurrLine.LineLength := CurrLine.CalculLength;
CurrLine.UpdateLengthTextBox(false, true);
SetLineFigureLengthInPM(CurrLine.ID, CurrLine.LineLength);
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('ReCalcAllLinesLength', E.Message);
end;
end;
procedure RaiseActiveNet(aCad: TF_CAD);
var
i: integer;
NetObject: TNet;
NetExistObject: TNet;
begin
try
//NetExistObject := nil;
// for i := 0 to aCad.PCad.FigureCount - 1 do
// begin
// if CheckFigureByClassName(TFigure(aCad.PCad.Figures[i]), 'TNet') then
// NetExistObject := TNet(aCad.PCad.Figures[i]);
// end;
// // Net
// if NetExistObject <> nil then
// begin
// aCad.FActiveNet := NetExistObject;
// ActiveNet := aCad.FActiveNet;
// aCad.FActiveNet.MapScale := aCad.PCad.MapScale;
// ActiveNet.MapScale := aCad.PCad.Mapscale;
// if aCad.PCad.RulerMode = rmWorld then
// aCad.FActiveNet.WorldDim := True
// else
// aCad.FActiveNet.WorldDim := False;
// ActiveNet.WorldDim := aCad.FActiveNet.WorldDim;
// end
// else
// begin
// if not CheckFigureByClassName(aCad.FActiveNet, 'TNet') then
// begin
// aCad.FActiveNet := Tnet.create(8, mydsNormal, aCad.PCad);
// end;
// aCad.PCad.AddCustomFigure(8, aCad.FActiveNet, False);
// ActiveNet := aCad.FActiveNet;
// end;
NetExistObject := nil;
for i := 0 to aCad.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(aCad.PCad.Figures[i]), 'TNet') then
begin
NetObject := TNet(aCad.PCad.Figures[i]);
SetCADParamsToNet(aCad, NetObject);
// Åñëè ïðîñòî àðõ. ïëàí
if NetObject.FComponID = 0 then
begin
NetExistObject := NetObject;
aCad.FActiveNet := NetExistObject;
ActiveNet := aCad.FActiveNet;
end;
end;
end;
if NetExistObject = nil then
begin
if not CheckFigureByClassName(aCad.FActiveNet, 'TNet') then
begin
aCad.FActiveNet := Tnet.create(8, mydsNormal, aCad.PCad);
end;
aCad.PCad.AddCustomFigure(8, aCad.FActiveNet, False);
ActiveNet := aCad.FActiveNet;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.RaiseActiveNet', E.Message);
end;
end;
procedure SetCADParamsToNet(aCad: TF_CAD; ANetObj: TObject);
var
Net: TNet;
begin
if (aCad <> nil) and (ANetObj <> nil) then
begin
Net := TNet(ANetObj);
Net.MapScale := aCad.PCad.MapScale;
if aCad.PCad.RulerMode = rmWorld then
Net.WorldDim := True
else
Net.WorldDim := False;
end;
end;
procedure SetMapScaleToNets(aCad: TF_CAD);
var
i: integer;
NetObject: TNet;
begin
try
for i := 0 to aCad.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(aCad.PCad.Figures[i]), 'TNet') then
begin
NetObject := TNet(aCad.PCad.Figures[i]);
NetObject.SetMapScale(aCad.PCad.MapScale); //NetObject.MapScale := aCad.PCad.MapScale;
end;
end;
except
on E: Exception do AddExceptionToLogEx('SetMapScaleToNets', E.Message);
end;
end;
procedure SetAllInFiguresVisible(AGroup: TFigureGrp; AVisible: Boolean);
var
i, j: integer;
InFigure: TFigure;
begin
try
for i := 0 to AGroup.InFigures.Count - 1 do
begin
AGroup.Visible := AVisible;
InFigure := TFigureGrp(AGroup.InFigures[i]);
if (InFigure is TFigureGrp) then
begin
SetAllInFiguresVisible(TFigureGrp(InFigure), AVisible);
end
else
begin
InFigure.Visible := AVisible;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetAllInFiguresVisible', E.Message);
end;
end;
procedure SetAllStampFiguresLayer(AGroup: TFigureGrp; ALHandle: Integer);
var
i, j: integer;
InFigure: TFigure;
begin
try
for i := 0 to AGroup.InFigures.Count - 1 do
begin
AGroup.LayerHandle := ALHandle;
InFigure := TFigureGrp(AGroup.InFigures[i]);
if (InFigure is TFigureGrp) then
begin
SetAllStampFiguresLayer(TFigureGrp(InFigure), ALHandle);
end
else
begin
InFigure.LayerHandle := ALHandle;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetAllFiguresFromStamp', E.Message);
end;
end;
procedure SetAllStampTextsFont(AGroup: TFigureGrp; aFontName: string);
var
i, j: integer;
InFigure: TFigure;
begin
try
for i := 0 to AGroup.InFigures.Count - 1 do
begin
InFigure := TFigureGrp(AGroup.InFigures[i]);
if (InFigure is TFigureGrp) then
begin
SetAllStampTextsFont(TFigureGrp(InFigure), aFontName);
end
else
if CheckFigureByClassName(InFigure, 'TText') then
begin
if TText(InFigure).Font.Name <> aFontName then
TText(InFigure).Font.Name := aFontName;
end
else
if CheckFigureByClassName(InFigure, 'TRichText') then
begin
if TRichText(InFigure).re.Font.Name <> aFontName then
TRichText(InFigure).re.Font.Name := aFontName;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetAllStampTextsFont', E.Message);
end;
end;
procedure UpdateForTexts(aFontName: string);
var
i: integer;
FFigure: TFigure;
Stamp: TFigureGrp;
LHandle: Integer;
begin
try
LHandle := GCadForm.PCad.GetLayerHandle(7);
// SetAllStampTextsFont(TFigureGrp(GCadForm.FFrame), aFontName);
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
FFigure := TFigure(GCadForm.PCad.Figures[i]);
if FFigure is TFigureGrp then
SetAllStampTextsFont(TFigureGrp(FFigure), aFontName);
if CheckFigureByClassName(FFigure, 'TText') then
begin
if TText(FFigure).Font.Name <> aFontName then
TText(FFigure).Font.Name := aFontName;
end;
if CheckFigureByClassName(FFigure, 'TRichText') then
begin
if TRichText(FFigure).re.Font.Name <> aFontName then
TRichText(FFigure).re.Font.Name := aFontName;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.UpdateForTexts', E.Message);
end;
end;
procedure ChangeObjectID(aListID, aOldID, aNewID: Integer);
var
FList: TF_CAD;
FFigure: TFigure;
begin
try
if aOldID <> aNewID then
begin
FList := GetListByID(aListID);
if FList <> nil then
begin
FFigure := GetFigureByID(FList, aOldID);
if FFigure <> nil then
if CheckFigureByClassName(FFigure, cTConnectorObject) or CheckFigureByClassName(FFigure, cTOrthoLine) then
FFigure.ID := aNewID;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ChangeObjectID', E.Message);
end;
end;
procedure ChangeCabinetID(aListID, aOldID, aNewID: Integer);
var
FList: TF_CAD;
Cabinet: TFigure;
begin
try
if aOldID <> aNewID then
begin
FList := GetListByID(aListID);
if FList <> nil then
begin
Cabinet := FindCabinetBySCSID(Flist, aOldID);
if Cabinet <> nil then
begin
if CheckFigureByClassname(Cabinet, cTCabinet) then
begin
TCabinet(Cabinet).FSCSID := aNewID;
TCabinet(Cabinet).ID := aNewID;
TCabinet(Cabinet).FNumberObject.FCabinetID := TCabinet(Cabinet).FSCSID;
end
else if CheckFigureByClassname(Cabinet, cTCabinetExt) then
begin
TCabinetExt(Cabinet).FSCSID := aNewID;
TCabinetExt(Cabinet).ID := aNewID;
TCabinetExt(Cabinet).FNumberObject.FCabinetID := TCabinetExt(Cabinet).FSCSID;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ChangeCabinetID', E.Message);
end;
end;
function GetBetweenFloorObjectsID(AID_List: Integer; aClearJoins: Boolean = False): TIntList;
var
i, j, k: integer;
FList: TF_CAD;
FFigure: TFigure;
InFigure: TFigure;
FConn: TConnectorObject;
FLine: TOrthoLine;
begin
Result := TIntList.Create;
try
FList := GetListByID(AID_List);
if FList <> nil then
begin
for i := 0 to FList.PCad.FigureCount - 1 do
begin
FFigure := TFigure(FList.PCad.Figures[i]);
if FFigure <> nil then
begin
// ÍÀéäåíà ãðóïïà - èñêàòü â íåé
if CheckFigureByClassName(FFigure, cTSCSFigureGrp) then
begin
for k := 0 to TSCSFigureGrp(FFigure).InFigures.Count - 1 do
begin
InFigure := TFigure(TSCSFigureGrp(FFigure).InFigures[k]);
if CheckFigureByClassName(InFigure, cTConnectorObject) then
begin
FConn := TConnectorObject(InFigure);
if (FConn.FConnRaiseType = crt_BetweenFloorUp) or (FConn.FConnRaiseType = crt_BetweenFloorDown) or (FConn.FConnRaiseType = crt_TrunkUp) or (FConn.FConnRaiseType = crt_TrunkDown) then
begin
for j := 0 to FConn.JoinedOrtholinesList.Count - 1 do
begin
FLine := TOrthoLine(FConn.JoinedOrtholinesList[j]);
if FLine.FIsRaiseUpDown then
Result.Add(FLine.ID);
end;
// î÷èñòèòü ñâÿçè ñ äðóãèìè ýòàæàìè
// ïðè êîïèðîâàíèè ëèñòîâ
if aClearJoins then
begin
FConn.FID_ListToPassage := -1;
FConn.FID_ConnToPassage := -1;
end;
end;
end;
end;
end
else
// èñêàòü íà ñàìîì ÊÀÄå
begin
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
FConn := TConnectorObject(FFigure);
if (FConn.FConnRaiseType = crt_BetweenFloorUp) or (FConn.FConnRaiseType = crt_BetweenFloorDown) or (FConn.FConnRaiseType = crt_TrunkUp) or (FConn.FConnRaiseType = crt_TrunkDown) then
begin
for j := 0 to FConn.JoinedOrtholinesList.Count - 1 do
begin
FLine := TOrthoLine(FConn.JoinedOrtholinesList[j]);
if FLine.FIsRaiseUpDown then
Result.Add(FLine.ID);
end;
// î÷èñòèòü ñâÿçè ñ äðóãèìè ýòàæàìè
// ïðè êîïèðîâàíèè ëèñòîâ
if aClearJoins then
begin
FConn.FID_ListToPassage := -1;
FConn.FID_ConnToPassage := -1;
end;
end;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetBetweenFloorObjectsID', E.Message);
end;
end;
procedure RemoveInFigureGrp(aFigureGrp: TFigureGrp);
var
i: integer;
InFigure: TFigureGrp;
FFigure: TFigure;
begin
try
i := 0;
while i < aFigureGrp.InFigures.Count do
begin
if CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrp') or
CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrpMod') or
CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrpNotMod') then
begin
InFigure := TFigureGrp(aFigureGrp.InFigures[i]);
if Assigned(InFigure.FBeforeDelFromParent) then //22.09.2011
InFigure.FBeforeDelFromParent(InFigure);
RemoveInFigureGrp(InFigure);
aFigureGrp.RemoveFromGrp(InFigure); //28.04.2011 aFigureGrp.InFigures.Remove(InFigure);
try
FreeAndNil(InFigure);
except
end;
end
else
begin
FFigure := TFigure(aFigureGrp.InFigures[i]);
if Assigned(FFigure.FBeforeDelFromParent) then //22.09.2011
FFigure.FBeforeDelFromParent(FFigure);
aFigureGrp.RemoveFromGrp(FFigure); //28.04.2011 aFigureGrp.InFigures.Remove(FFigure);
try
FreeAndNil(FFigure);
except
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message);
end;
end;
{
procedure ClearFiguresOnListDelete(aCAD: TF_CAD);
var
i, j, k, l: integer;
FFigure, InFigure: TFigure;
FigList: TList;
OldTick, CurrTick: Cardinal;
Procedure DelInfigures(aFigure: TFigure);
var i, j :Integer;
inFigure: TFigure;
begin
j := TFigureGrp(aFigure).InFigures.Count - 1;
for i := j downto 0 do
begin
inFigure := TFigure(TFigureGRP(aFigure).InFigures[i]);
if inFigure is TFigureGrp then
DelInfigures(inFigure)
else
FreeAndNil(inFigure);
end;
end;
begin
try
OldTick := GetTickCount;
aCAD.PCad.DisableAlign;
aCAD.PCad.BeginMultiDeselect; //02.04.2012
aCad.PCad.Locked := true;
try
j := aCad.PCad.FigureCount - 1;
for i := j downto 0 do
begin
FFigure := TFigure(aCad.PCad.Figures[i]);
if FFigure <> nil then
begin
// ïðîâåðèòü, åñëè ìåæýòàæíûé òî óäàëèòü íà äðóãîì ýòàæå
// ÅÑËÈ ËÈÑÒ ÓÄÀËßÅÒÑß ÑÀÌ (íå çàêðûòèå ïðîåêòà)
if aCad.FNeedDelete then
begin
if CheckFigureByClassName(FFigure, cTConnectorObject) then
if (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorDown) or
(TConnectorObject(FFigure).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_TrunkDown) then
DeleteRaiseOtherFloor(TConnectorObject(FFigure));
end;
//
if FFigure is TFigureGrp then
begin
DelInFigures(FFigure);
end;
//aCad.PCad.Figures.Remove(FFigure);
try
FreeAndNil(FFigure);
except
end;
end;
end;
finally
end;
CurrTick := GetTickCount - OldTick;
CurrTick := GetTickCount - OldTick;
except
on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message);
end;
end;
}
procedure ClearFiguresOnListDelete(aCAD: TF_CAD);
var
i, j: integer;
FFigure: TFigure;
FigList, GrpFigList: TList;
OldTick, CurrTick: Cardinal;
procedure DeleteGRPFigures(aFigureGrp: TFigureGrp; aCad: TF_Cad);
var
i: integer;
InFigure: TFigureGrp;
FFigure: TFigure;
begin
try
if Assigned(aFigureGrp) then
begin
if Assigned(aFigureGrp.inFigures) then
begin
i := 0;
for i := 0 to aFigureGrp.inFigures.Count - 1 do
begin
FFigure := TFigure(aFigureGrp.inFigures[i]);
if aCad.PCad.Figures.IndexOf(FFigure) = -1 then
begin
try
if GrpFigList.IndexOf(FFigure) = -1 then
GrpFigList.Add(FFigure);
if FFigure is TFigureGrp then
DeleteGrpFigures(TFigureGrp(FFigure), aCad)
else
if CheckFigureByClassName(FFigure, 'TBlock') then
DeleteGrpFigures(TFigureGrp(FFigure), aCad);
except
on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message);
end;
end;
end;
aFigureGrp.InFigures.Clear;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message);
end;
end;
begin
try
GrpFigList := TList.Create;
OldTick := GetTickCount;
aCAD.PCad.DisableAlign;
aCAD.PCad.BeginMultiDeselect; //02.04.2012
aCad.PCad.Locked := true;
try
FigList := TList.Create;
for i := 0 to aCad.PCad.FigureCount - 1 do
begin
FFigure := TFigure(aCad.PCad.Figures[i]);
FigList.Add(FFigure);
end;
for i := 0 to FigList.Count - 1 do
//for i := j downto 0 do
begin
FFigure := TFigure(FigList[i]);
// FFigure := TFigure(aCad.PCad.Figures[i]);
if FFigure <> nil then
begin
// ïðîâåðèòü, åñëè ìåæýòàæíûé òî óäàëèòü íà äðóãîì ýòàæå
// ÅÑËÈ ËÈÑÒ ÓÄÀËßÅÒÑß ÑÀÌ (íå çàêðûòèå ïðîåêòà)
if aCad.FNeedDelete then
begin
if CheckFigureByClassName(FFigure, cTConnectorObject) then
if (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorDown) or
(TConnectorObject(FFigure).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_TrunkDown) then
DeleteRaiseOtherFloor(TConnectorObject(FFigure));
end;
try
if GrpFigList.IndexOf(FFigure) = -1 then
GrpFigList.Add(FFigure);
if FFigure is TFigureGrp then
begin
DeleteGRPFigures(TFigureGrp(FFigure), aCAD)
end
else
if CheckFigureByClassName(FFigure, 'TBlock') then
DeleteGrpFigures(TFigureGrp(FFigure), aCad);
except
end;
end;
end;
FigList.Clear;
FreeAndNil(FigList);
//aCad.FSCSFigures.Clear;
//Tolik
for i := 0 to aCad.PCad.Figures.Count - 1 do
begin
FFigure := TFigure(aCad.PCad.Figures[i]);
if GrpFigList.IndexOf(fFigure) = -1 then
GrpFigList.Add(FFigure);
end;
{ for i := 0 to GrpFigList.Count - 1 do
begin
FFigure := TFigure(GrpFigList[i]);
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
for j := 0 to TOrthoLine(FFigure).JoinedFigures.Count - 1 do
begin
if GrpFigList.IndexOf(TFigure(TOrthoLine(FFigure).JoinedFigures[j])) = -1 then
GrpFigList.Add(TOrthoLine(FFigure).JoinedFigures[j]);
end;
if GrpFigList.IndexOf(TOrthoLine(FFigure).JoinConnector1) = -1 then
GrpFigList.Add(TOrthoLine(FFigure).JoinConnector1);
if GrpFigList.IndexOf(TOrthoLine(FFigure).JoinConnector2) = -1 then
GrpFigList.Add(TOrthoLine(FFigure).JoinConnector2);
if GrpFigList.IndexOf(TOrthoLine(FFigure).JoinFigure1 ) = -1 then
GrpFigList.Add(TOrthoLine(FFigure).JoinFigure1);
if GrpFigList.IndexOf(TOrthoLine(FFigure).JoinFigure1 ) = -1 then
GrpFigList.Add(TOrthoLine(FFigure).JoinFigure1);
end;
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
for j := 0 to TConnectorObject(FFigure).JoinedOrtholinesList.Count - 1 do
begin
if GrpFigList.IndexOf(TFigure(TConnectorObject(FFigure).JoinedOrtholinesList[j])) = -1 then
GrpFigList.Add(TFigure(TConnectorObject(FFigure).JoinedOrtholinesList[j]));
end;
for j := 0 to TConnectorObject(FFigure).JoinedConnectorsList.Count - 1 do
begin
if GrpFigList.IndexOf(TFigure(TConnectorObject(FFigure).JoinedConnectorsList[j])) = -1 then
GrpFigList.Add(TFigure(TConnectorObject(FFigure).JoinedConnectorsList[j]));
end;
for j := 0 to TConnectorObject(FFigure).JoinedFigures.Count - 1 do
begin
if GrpFigList.IndexOf(TFigure(TConnectorObject(FFigure).JoinedFigures[j])) = -1 then
GrpFigList.Add(TFigure(TConnectorObject(FFigure).JoinedFigures[j]));
end;
end;
end; }
for i := 0 to GrpFigList.Count - 1 do
begin
FFigure := TFigure(GrpFigList[i]);
if Assigned(FFigure) then
begin
try
FreeAndNil(FFigure);
except
on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message);
end;
end;
end;
GrpFigList.Clear;
FreeAndNil(GrpFigList);
aCad.PCad.Figures.Clear;
aCad.FSCSFigures.Clear;
finally
aCAD.PCad.EndMultiDeselect;
aCAD.PCad.EnableAlign;
end;
CurrTick := GetTickCount - OldTick;
CurrTick := GetTickCount - OldTick;
except
on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message);
end;
end;
(*
procedure ClearFiguresOnListDelete(aCAD: TF_CAD);
var
i, j: integer;
FFigure: TFigure;
FigList, GrpFigList: TList;
OldTick, CurrTick: Cardinal;
procedure DeleteGRPFigures(aFigureGrp: TFigureGrp; aCad: TF_Cad);
var
i: integer;
InFigure: TFigureGrp;
FFigure: TFigure;
begin
try
if Assigned(aFigureGrp) then
begin
if Assigned(aFigureGrp.inFigures) then
begin
i := 0;
for i := 0 to aFigureGrp.inFigures.Count - 1 do
begin
FFigure := TFigure(aFigureGrp.inFigures[i]);
if aCad.PCad.Figures.IndexOf(FFigure) = -1 then
begin
try
FreeAndNil(FFigure);
except
on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message);
end;
end;
end;
{while i < aFigureGrp.InFigures.Count do
begin
// ãðóïïîâàÿ ôèãóðà
if CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrp') or
CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrpMod') or
// CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TBlock') or
CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrpNotMod') then
//Tolik
begin
InFigure := TFigureGrp(aFigureGrp.InFigures[i]);
if Assigned(InFigure) then
begin
{ if Assigned(InFigure.FBeforeDelFromParent) then //22.09.2011
InFigure.FBeforeDelFromParent(InFigure);}
{
DeleteGRPFigures(InFigure, aCad);
aFigureGrp.RemoveFromGrp(InFigure); //28.04.2011 aFigureGrp.InFigures.Remove(InFigure);
// åñëè íåò â ñïèñêå ôèãóð êàäà - äîáàâèòü â îáùèé
if aCad.PCad.Figures.IndexOf(inFigure) = -1 then
//GrpFigList.Add(inFigure);
FreeAndNil(inFigure);
end;
end
else
//Ïðîñòàÿ ôèãóðà
begin
FFigure := TFigure(aFigureGrp.InFigures[i]);
if Assigned(FFigure) then
begin
if CheckFigureByClassName(FFigure, 'TBlock') then
showmessage('TBlock Catched');
// åñëè íåò â ñïèñêå ôèãóð Êàäà - óäàëèòü íàõ
if ACad.PCad.Figures.IndexOf(FFigure) = -1 then
begin
if Assigned(FFigure.FBeforeDelFromParent) then //22.09.2011
FFigure.FBeforeDelFromParent(FFigure);
aFigureGrp.RemoveFromGrp(FFigure); //28.04.2011 aFigureGrp.InFigures.Remove(FFigure);
try
FreeAndNil(FFigure);
except
end;
end;
end;
end;
end;}
aFigureGRP.InFigures.Clear;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message);
end;
end;
begin
try
OldTick := GetTickCount;
GrpFigList := TList.Create;
aCAD.PCad.DisableAlign;
aCAD.PCad.BeginMultiDeselect; //02.04.2012
aCad.PCad.Locked := true;
try
FigList := TList.Create;
for i := 0 to aCad.PCad.FigureCount - 1 do
begin
FFigure := TFigure(aCad.PCad.Figures[i]);
FigList.Add(FFigure);
end;
for i := 0 to FigList.Count - 1 do
//for i := j downto 0 do
begin
FFigure := TFigure(FigList[i]);
// FFigure := TFigure(aCad.PCad.Figures[i]);
if FFigure <> nil then
begin
// ïðîâåðèòü, åñëè ìåæýòàæíûé òî óäàëèòü íà äðóãîì ýòàæå
// ÅÑËÈ ËÈÑÒ ÓÄÀËßÅÒÑß ÑÀÌ (íå çàêðûòèå ïðîåêòà)
if aCad.FNeedDelete then
begin
if CheckFigureByClassName(FFigure, cTConnectorObject) then
if (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorDown) or
(TConnectorObject(FFigure).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_TrunkDown) then
DeleteRaiseOtherFloor(TConnectorObject(FFigure));
end;
//
{ if FFigure is TFigureGrp then
RemoveInFigureGrp(TFigureGrp(FFigure));
aCad.PCad.Figures.Remove(FFigure);}
try
if FFigure is TFigureGrp then
begin
DeleteGRPFigures(TFigureGrp(FFigure), aCAD)
end
else
begin
aCad.PCad.Figures.Remove(FFigure);
FreeAndNil(FFigure);
end;
except
end;
end;
end;
FigList.Clear;
FreeAndNil(FigList);
//aCad.FSCSFigures.Clear;
//Tolik
for i := 0 to aCad.PCad.Figures.Count - 1 do
begin
FFigure := TFigure(aCad.PCad.Figures[i]);
try
FreeAndNil(FFigure);
except
on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message);
end;
end;
{
for i := 0 to GrpFigList.Count - 1 do
begin
FFigure := TFigure(aCad.PCad.Figures[0]);
if Assigned(FFigure) then
begin
try
//aCad.FSCSFigures.Remove(FFigure.ID);
FreeAndNil(FFigure);
except
on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message);
end;
end;
end;
}
{ while aCad.PCad.FigureCount > 0 do
begin
FFigure := TFigure(aCad.PCad.Figures[0]);
if Assigned(FFigure) then
begin
try
//aCad.FSCSFigures.Remove(FFigure.ID);
FreeAndNil(FFigure);
aCad.PCad.Figures.Delete(0);
Inc(CounterDeleted);
except
on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message);
end;
end
else
begin
aCad.PCad.Figures.Delete(0);
// Inc(CounterDeleted);
end;
end; }
aCad.PCad.Figures.Clear;
aCad.FSCSFigures.Clear;
finally
aCAD.PCad.EndMultiDeselect;
aCAD.PCad.EnableAlign;
end;
CurrTick := GetTickCount - OldTick;
CurrTick := GetTickCount - OldTick;
except
on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message);
end;
end; *)
(*
procedure ClearFiguresOnListDelete(aCAD: TF_CAD);
var
i, j: integer;
FFigure: TFigure;
FigList, GrpFigList: TList;
OldTick, CurrTick: Cardinal;
//Tolik
CounterDeleted: Integer;
//Procedure DeleteGRPFigures
procedure DeleteGRPFigures(aFigureGrp: TFigureGrp; aCad: TF_Cad);
var
i: integer;
InFigure: TFigureGrp;
FFigure: TFigure;
begin
try
if Assigned(aFigureGrp) then
begin
if Assigned(aFigureGrp.inFigures) then
begin
i := 0;
while i < aFigureGrp.InFigures.Count do
begin
// ãðóïïîâàÿ ôèãóðà
if CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrp') or
CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrpMod') or
// CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TBlock') or
CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrpNotMod') then
//Tolik
begin
InFigure := TFigureGrp(aFigureGrp.InFigures[i]);
if Assigned(InFigure) then
begin
{ if Assigned(InFigure.FBeforeDelFromParent) then //22.09.2011
InFigure.FBeforeDelFromParent(InFigure);}
DeleteGRPFigures(InFigure, aCad);
aFigureGrp.RemoveFromGrp(InFigure); //28.04.2011 aFigureGrp.InFigures.Remove(InFigure);
// åñëè íåò â ñïèñêå ôèãóð êàäà - äîáàâèòü â îáùèé
if aCad.PCad.Figures.IndexOf(inFigure) = -1 then
begin
if GrpFigList.IndexOF(inFigure) = -1 then
GrpFigList.Add(inFigure);
// FreeAndNil(inFigure);
end;
end;
end
else
//Ïðîñòàÿ ôèãóðà - óäàëèòü íàõ
begin
FFigure := TFigure(aFigureGrp.InFigures[i]);
if Assigned(FFigure) then
begin
// åñëè íåò â ñïèñêå ôèãóð Êàäà - óäàëèòü íàõ
if ACad.PCad.Figures.IndexOf(FFigure) = -1 then
begin
if Assigned(FFigure.FBeforeDelFromParent) then //22.09.2011
FFigure.FBeforeDelFromParent(FFigure);
aFigureGrp.RemoveFromGrp(FFigure); //28.04.2011 aFigureGrp.InFigures.Remove(FFigure);
try
FreeAndNil(FFigure);
except
on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message);
end;
end;
end;
end;
end;
//aFigureGRP.InFigures.Clear;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message);
end;
end;
begin
try
CounterDeleted := 0;
OldTick := GetTickCount;
GrpFigList := TList.Create;
aCAD.PCad.DisableAlign;
aCAD.PCad.BeginMultiDeselect; //02.04.2012
aCad.PCad.Locked := true;
try
FigList := TList.Create;
for i := 0 to aCad.PCad.FigureCount - 1 do
begin
FFigure := TFigure(aCad.PCad.Figures[i]);
FigList.Add(FFigure);
end;
for i := 0 to FigList.Count - 1 do
//for i := j downto 0 do
begin
FFigure := TFigure(FigList[i]);
// FFigure := TFigure(aCad.PCad.Figures[i]);
if FFigure <> nil then
begin
// ïðîâåðèòü, åñëè ìåæýòàæíûé òî óäàëèòü íà äðóãîì ýòàæå
// ÅÑËÈ ËÈÑÒ ÓÄÀËßÅÒÑß ÑÀÌ (íå çàêðûòèå ïðîåêòà)
if aCad.FNeedDelete then
begin
if CheckFigureByClassName(FFigure, cTConnectorObject) then
if (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorDown) or
(TConnectorObject(FFigure).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_TrunkDown) then
DeleteRaiseOtherFloor(TConnectorObject(FFigure));
end;
//
{ if FFigure is TFigureGrp then
RemoveInFigureGrp(TFigureGrp(FFigure));
aCad.PCad.Figures.Remove(FFigure);}
try
if FFigure is TFigureGrp then
begin
if CheckFigureByClassName(FFigure, 'TBlock') then
Showmessage('TBLock Catched!');
DeleteGRPFigures(TFigureGrp(FFigure), aCAD)
end
else
begin
aCad.PCad.Figures.Remove(FFigure);
//aCad.FSCSFigures.Remove(FFigure.ID);
try
FreeAndNil(FFigure);
except
on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message);
end;
Inc(CounterDeleted);
end;
except
end;
end;
end;
FigList.Clear;
FreeAndNil(FigList);
//aCad.FSCSFigures.Clear;
//Tolik
{for i := 0 to aCad.PCad.Figures.Count - 1 do
begin
FFigure := TFigure(aCad.PCad.Figures[i]);
if GrpFigList.IndexOf(FFigure) = -1 then
GrpFigList.Add(FFigure);
end; }
for i := 0 to GrpFigList.Count - 1 do
begin
FFigure := TFigure(GrpFigList[i]);
if Assigned(FFigure) then
begin
try
FreeAndNil(FFigure);
except
on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message);
end;
end;
end;
{while aCad.PCad.FigureCount > 0 do
begin
FFigure := TFigure(aCad.PCad.Figures[0]);
if Assigned(FFigure) then
begin
try
//aCad.FSCSFigures.Remove(FFigure.ID);
FreeAndNil(FFigure);
aCad.PCad.Figures.Delete(0);
Inc(CounterDeleted);
except
on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message);
end;
end
else
begin
aCad.PCad.Figures.Delete(0);
// Inc(CounterDeleted);
end;
end;}
GrpFigList.Clear;
FreeAndNil(GrpFigList);
aCad.PCad.Figures.Clear;
aCad.FSCSFigures.Clear;
finally
aCAD.PCad.EndMultiDeselect;
aCAD.PCad.EnableAlign;
end;
CurrTick := GetTickCount - OldTick;
CurrTick := GetTickCount - OldTick;
except
on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message);
end;
end; *)
function CanListsInterchange(AIDMoveList, AID_List2: Integer; aMessRes: PInteger=nil; aMsg: Boolean=true): Boolean;
var
i, j: Integer;
FList1, FList2: TF_CAD;
FFiguresList1: TList;
FFiguresList2: TList;
OtherList: TF_CAD;
Conn: TConnectorObject;
Line: TOrthoLine;
IsRaiseExist, IsRaiseExistOnMoveList: Boolean;
mess: string;
MessStyle: Integer; //04.04.2012
vLists: TList;
SavedGCadForm: TF_CAD;
DelObjs: Boolean;
MessRes: Integer;
begin
Result := False;
try
IsRaiseExist := False;
IsRaiseExistOnMoveList := false;
FList1 := GetListByID(AIDMoveList);
FList2 := GetListByID(AID_List2);
if (FList1 = nil) or (FList2 = nil) then
Exit;
FFiguresList1 := TList.Create;
FFiguresList2 := TList.Create;
vLists := TList.create;
vLists.Add(FList1);
vLists.Add(FList2);
for i := 0 to FList1.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(FList1.PCad.Figures[i]), cTConnectorObject) then
if (TConnectorObject(FList1.PCad.Figures[i]).FConnRaiseType = crt_BetweenFloorUp) or
(TConnectorObject(FList1.PCad.Figures[i]).FConnRaiseType = crt_BetweenFloorDown) or
(TConnectorObject(FList1.PCad.Figures[i]).FConnRaiseType = crt_TrunkUp) or
(TConnectorObject(FList1.PCad.Figures[i]).FConnRaiseType = crt_TrunkDown) then
begin
IsRaiseExist := True;
IsRaiseExistOnMoveList := true;
Conn := TConnectorObject(FList1.PCad.Figures[i]);
FFiguresList1.Add(Conn);
// ñâÿçóþùèå ýòàæè êðîìå òåõ êîòîðûå óæå â ñïèñêå
OtherList := GetListByID(Conn.FID_ListToPassage);
if OtherList <> nil then
if CheckNoCadInList(OtherList, vLists) then
vLists.Add(OtherList);
end;
end;
for i := 0 to FList2.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(FList2.PCad.Figures[i]), cTConnectorObject) then
if (TConnectorObject(FList2.PCad.Figures[i]).FConnRaiseType = crt_BetweenFloorUp) or
(TConnectorObject(FList2.PCad.Figures[i]).FConnRaiseType = crt_BetweenFloorDown) or
(TConnectorObject(FList2.PCad.Figures[i]).FConnRaiseType = crt_TrunkUp) or
(TConnectorObject(FList2.PCad.Figures[i]).FConnRaiseType = crt_TrunkDown) then
begin
IsRaiseExist := True;
Conn := TConnectorObject(FList2.PCad.Figures[i]);
FFiguresList2.Add(Conn);
// ñâÿçóþùèå ýòàæè êðîìå òåõ êîòîðûå óæå â ñïèñêå
OtherList := GetListByID(Conn.FID_ListToPassage);
if OtherList <> nil then
if CheckNoCadInList(OtherList, vLists) then
vLists.Add(OtherList);
end;
end;
if IsRaiseExist then
begin
//04.04.2012 mess := cCommon_Mes14;
if aMsg then
begin
// Åñëè åñòü íà ïåðåìåùàåìîì ëèñòå, òî ïðåäëàãàåì ðàçîðâàòü ñâÿçè
//04.04.2012 if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cCommon_Mes15, MB_YESNO) then
DelObjs := false;
MessRes := -1;
if aMessRes <> nil then
MessRes := aMessRes^;
if MessRes = -1 then
begin
if IsRaiseExistOnMoveList then
begin
mess := cCommon_Mes14;
MessStyle := MB_YESNO;
end
else
begin
mess := cCommon_Mes14_2;
MessStyle := MB_YESNOCANCEL;
end;
MessRes := MessageModal(mess, cCommon_Mes15, MessStyle);
if aMessRes <> nil then
aMessRes^ := MessRes;
end;
if MessRes = IDYes then
DelObjs := true;
if DelObjs then
begin
SaveForProjectUndo(vLists, True, False);
BeginProgress;
try
SavedGCadForm := GCadForm;
// óäàëåíèå âñåõ ì-ý ñ-ï
for i := 0 to FFiguresList1.Count - 1 do
begin
Conn := TConnectorObject(FFiguresList1[i]);
GCadForm := FList1;
Conn.Delete;
end;
for i := 0 to FFiguresList2.Count - 1 do
begin
Conn := TConnectorObject(FFiguresList2[i]);
GCadForm := FList2;
Conn.Delete;
end;
Result := True;
RefreshCAD(FList1.PCad);
RefreshCAD(FList2.PCad);
GCadForm := SavedGCadForm;
finally
EndProgress;
end;
end
else
Result := False;
end
else
Result := False;
end
else
Result := True;
FreeAndNil(FFiguresList1);
FreeAndNil(FFiguresList2);
FreeAndNil(vLists);
except
on E: Exception do addExceptionToLogEx('U_Common.CanListsInterchange', E.Message);
end;
end;
function CheckListWithFloorRaise(aListID: Integer): Boolean;
var
List: TF_CAD;
i: Integer;
Fig: TFigure;
begin
Result := false;
List := GetListByID(aListID);
if List <> nil then
for i := 0 to List.PCad.Figures.Count - 1 do
begin
Fig := TFigure(List.PCad.Figures[i]);
if CheckFigureByClassName(TFigure(Fig), cTConnectorObject) then
if (TConnectorObject(Fig).FConnRaiseType = crt_BetweenFloorUp) or
(TConnectorObject(Fig).FConnRaiseType = crt_BetweenFloorDown) or
(TConnectorObject(Fig).FConnRaiseType = crt_TrunkUp) or
(TConnectorObject(Fig).FConnRaiseType = crt_TrunkDown) then
begin
Result := true;
Break; //// BREAK ////
end;
end;
end;
function GetTraceInfo(AID_List: Integer): TList;
var
FList: TF_CAD;
i: integer;
CurrTrace: TOrthoLine;
ptrTraceInfo: PTraceInfo;
begin
Result := TList.Create;
try
FList := GetListByID(AID_List);
if FList <> nil then
begin
for i := 0 to FList.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(FList.PCad.Figures[i]), cTOrthoLine) then
begin
CurrTrace := TOrthoLine(FList.PCad.Figures[i]);
New(ptrTraceInfo);
ptrTraceInfo.FigureID := CurrTrace.ID;
ptrTraceInfo.HeightSide1 := CurrTrace.ActualZOrder[1];
ptrTraceInfo.HeightSide2 := CurrTrace.ActualZOrder[2];
ptrTraceInfo.IsSelected := CurrTrace.Selected;
if (CurrTrace.FIsRaiseUpDown) or (CurrTrace.FIsVertical) then
begin
ptrTraceInfo.Position := tpVertical;
end
else
begin
if CurrTrace.ActualZOrder[1] = CurrTrace.ActualZOrder[2] then
ptrTraceInfo.Position := tpHorizontal
else
ptrTraceInfo.Position := tpIncline;
end;
Result.Add(ptrTraceInfo);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetTraceInfo', E.Message);
end;
end;
function IsStringListsDifferent(aStringList: TStringList; aStrings: TStrings): Boolean;
var
i, j: integer;
begin
Result := False;
try
if (aStringList = nil) or (aStrings = nil) then
begin
Result := True;
Exit;
end;
if aStringList.Count <> aStrings.Count then
begin
Result := True;
end
else
begin
for i := 0 to aStringList.Count - 1 do
begin
if aStringList[i] <> aStrings[i] then
Result := True;
end;
end;
except
on E: Exception do addExceptionToLogEx('TF_SCSObjectsProp.IsCompareStringLists', E.Message);
end;
end;
procedure FindObjectsForConvertClasses;
var
i, j: integer;
FLine: TOrthoLine;
FConn: TConnectorObject;
NotesCaptions: TRichTextMod;
Captions: TRichTextMod;
LinesList: TList;
ConnsList: TList;
Str: string;
Background: TRectangle;
SCSFigureGrp: TSCSFigureGrp;
begin
try
LinesList := TList.Create;
ConnsList := TList.Create;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then
begin
LinesList.Add(TFigure(GCadForm.PCad.Figures[i]));
end;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then
begin
ConnsList.Add(TFigure(GCadForm.PCad.Figures[i]));
end;
// Â ÃÐÓÏÏÅ
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTSCSFigureGrp) then
begin
SCSFigureGrp := TSCSFigureGrp(GCadForm.PCad.Figures[i]);
for j := 0 to SCSFigureGrp.InFigures.Count - 1 do
begin
if CheckFigureByClassName(TFigure(SCSFigureGrp.InFigures[j]), cTConnectorObject) then
TConnectorObject(SCSFigureGrp.InFigures[j]).CaptionsGroup := TRichTextMod(TConnectorObject(SCSFigureGrp.InFigures[j]).tmpCaptionsGroup);
if CheckFigureByClassName(TFigure(SCSFigureGrp.InFigures[j]), cTOrthoLine) then
TOrthoLine(SCSFigureGrp.InFigures[j]).CaptionsGroup := TFigureGrpNotMod(TOrthoLine(SCSFigureGrp.InFigures[j]).tmpCaptionsGroup);
end;
end;
end;
// Êîíâåðòèòü êëàññû
for i := 0 to LinesList.Count - 1 do
begin
FLine := TOrthoLine(LinesList[i]);
// CaptionGroup
if FLine.tmpCaptionsGroup <> nil then
begin
// ñòàðûå ôîðìàòû
if FLine.tmpCaptions = nil then
begin
GCadForm.PCad.Figures.Remove(FLine.tmpCaptionsGroup);
FreeAndNil(FLine.tmpCaptionsGroup);
FLine.ReCreateCaptionsGroup(True, false);
end
// ñàìûé íîâûé ôîðìàò
else
begin
FLine.CaptionsGroup := TFigureGrpNotMod(FLine.tmpCaptionsGroup);
end;
FLine.CaptionsGroup.LockModify := True;
FLine.tmpCaptionsGroup := nil;
FLine.tmpCaptions := nil;
end
else
begin
FLine.CalculLength := FLine.LengthCalc;
FLine.LineLength := FLine.CalculLength;
if FLine.OutTextCaptions.Count = 0 then
begin
Str := GetLineCaptionFormat(FLine, GCadForm.FShowLineCaptionsType);
FLine.OutTextCaptions.Add(Str);
end
else
begin
Str := GetLineCaptionFormat(FLine, GCadForm.FShowLineCaptionsType);
FLine.OutTextCaptions[0] := Str;
end;
FLine.ReCreateCaptionsGroup(True, false);
end;
// NotesCaptions
if FLine.tmpNotesCaptions <> nil then
begin
if CheckFigureByClassName(FLine.tmpNotesCaptions, cTFigureGrpNotMod) then
begin
FLine.NotesGroup := ConvertNotesGroupToRichText(FLine.NotesGroup, True);
FLine.ReCreateNotesGroup;
end;
FLine.NotesGroup.LockModify := True;
FLine.tmpNotesCaptions := nil;
end
else
begin
FLine.ReCreateNotesGroup(True);
end;
end;
for i := 0 to ConnsList.Count - 1 do
begin
FConn := TConnectorObject(ConnsList[i]);
// CaptionGroup
if FConn.ConnectorType = ct_Clear then
begin
if FConn.tmpCaptionsGroup <> nil then
begin
if CheckFigureByClassName(FConn.tmpCaptionsGroup, cTFigureGrpNotMod) then
RemoveInFigureGrp(TFigureGrp(FConn.tmpCaptionsGroup));
GCadForm.PCad.Figures.Remove(FConn.tmpCaptionsGroup);
FreeAndNil(FConn.tmpCaptionsGroup);
end;
end;
if FConn.tmpCaptionsGroup <> nil then
begin
if CheckFigureByClassName(FConn.tmpCaptionsGroup, cTFigureGrpNotMod) then
begin
FConn.CaptionsGroup := ConvertCaptionsGroupToRichText(TFigureGrpNotMod(FConn.tmpCaptionsGroup), False);
FConn.ReCreateCaptionsGroup(false, false);
FConn.DefRaizeDrawFigurePos;
end
else
begin
FConn.CaptionsGroup := TRichTextMod(FConn.tmpCaptionsGroup);
end;
FConn.CaptionsGroup.LockModify := True;
FConn.tmpCaptionsGroup := nil;
end;
// NotesCaptions
if FConn.ConnectorType = ct_Clear then
begin
if FConn.NotesGroup <> nil then
begin
RemoveInFigureGrp(TFigureGrp(FConn.NotesGroup));
GCadForm.PCad.Figures.Remove(FConn.NotesGroup);
FreeAndNil(FConn.NotesGroup);
end;
end;
if FConn.NotesGroup <> nil then
if FConn.tmpNotesCaptions <> nil then
begin
if CheckFigureByClassName(FConn.tmpNotesCaptions, cTFigureGrpNotMod) then
begin
FConn.NotesGroup := ConvertNotesGroupToRichText(FConn.NotesGroup, False);
FConn.ReCreateNotesGroup;
end
else
begin
end;
FConn.NotesGroup.LockModify := True;
FConn.tmpNotesCaptions := nil;
end;
end;
FreeAndNil(LinesList);
FreeAndNil(ConnsList);
except
on E: Exception do addExceptionToLogEx('U_Common.FindObjectsForConvertClasses', E.Message);
end;
end;
Function ConvertCaptionsGroupToRichText(aCaptionsGroup: TFigureGrpNotMod; aIsLine: Boolean): TRichTextMod;
var
i: integer;
tempstr: string;
StrList: TStringList;
LHandle: Integer;
CPoints: TDoublePoint;
Angle: Double;
RichTextMod: TRichTextMod;
TM: TTextMetric;
xCanvas: TMetafileCanvas;
h, w: double;
begin
Result := nil;
try
// ñîõðàíèòü äàííûå ñ FigureGroup
CPoints := aCaptionsGroup.CenterPoint;
LHandle := aCaptionsGroup.LayerHandle;
Angle := aCaptionsGroup.AngletoPoint;
StrList := TStringList.Create;
for i := 0 to aCaptionsGroup.InFigures.Count - 1 do
begin
tempstr := TText(aCaptionsGroup.InFigures[i]).Text;
StrList.Add(tempstr);
end;
// óäàëèòü FigureGroup
RemoveInFigureGrp(aCaptionsGroup);
GCadForm.PCad.Figures.Remove(aCaptionsGroup);
FreeAndNil(aCaptionsGroup);
// Ñîçäàòü è Îáðàáîòàòü RichText
if aIsLine then
RichTextMod := TRichTextMod.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack,
LHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Caption)
else
RichTextMod := TRichTextMod.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack,
LHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Caption);
RichTextMod.RE.Lines.Clear;
for i := 0 to StrList.Count - 1 do
RichTextMod.re.Lines.Add(StrList.Strings[i]);
GCadForm.PCad.AddCustomFigure(GLN (LHandle), RichTextMod, False);
RefreshCAD(GCadForm.PCad);
xCanvas := TMetafileCanvas.Create(RichTextMod.Metafile, 0);
xCanvas.Font.Name := RichTextMod.re.Font.Name;
xCanvas.Font.Size := RichTextMod.re.Font.Size;
GetTextMetrics(xCanvas.Handle, TM);
h := TM.tmHeight / 4 * RichTextMod.re.Lines.Count + 1;
w := 0;
for i := 0 to RichTextMod.re.Lines.Count - 1 do
begin
if w < xCanvas.TextWidth(RichTextMod.Re.Lines[i]) then
w := xCanvas.TextWidth(RichTextMod.Re.Lines[i]);
end;
w := (w + 3) / 4 ;
FreeAndNil(xCanvas);
GCadForm.PCad.Figures.Remove(RichTextMod);
FreeAndNil(RichTextMod);
if aIsLine then
RichTextMod := TRichTextMod.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack,
LHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Caption)
else
RichTextMod := TRichTextMod.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack,
LHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Caption);
RichTextMod.RE.Lines.Clear;
for i := 0 to StrList.Count - 1 do
RichTextMod.re.Lines.Add(StrList.Strings[i]);
RichTextMod.Move(CPoints.x - RichTextMod.CenterPoint.x, CPoints.y - RichTextMod.CenterPoint.y);
RichTextMod.rotate(Angle, RichTextMod.CenterPoint);
GCadForm.PCad.AddCustomFigure(GLN (LHandle), RichTextMod, False);
//
FreeAndNil(StrList);
Result := RichTextMod;
except
on E: Exception do addExceptionToLogEx('U_Common.ConvertCaptionsGroupToRichText', E.Message);
end;
end;
Function ConvertNotesGroupToRichText(aNotesGroup: TFigureGrpNotMod; aIsLine: Boolean): TFigureGrpNotMod;
var
i: integer;
tempstr: string;
StrList: TStringList;
LHandle: Integer;
CPoints: TDoublePoint;
Angle: Double;
RichTextMod: TRichTextMod;
TM: TTextMetric;
xCanvas: TMetafileCanvas;
h, w: double;
NotesCaptions: TFigureGrpNotMod;
begin
Result := nil;
try
NotesCaptions := TFigureGrpNotMod(aNotesGroup.InFigures[1]);
// ñîõðàíèòü äàííûå ñ FigureGroup
CPoints := NotesCaptions.CenterPoint;
LHandle := NotesCaptions.LayerHandle;
Angle := NotesCaptions.AngletoPoint;
StrList := TStringList.Create;
for i := 0 to NotesCaptions.InFigures.Count - 1 do
begin
tempstr := TText(NotesCaptions.InFigures[i]).Text;
StrList.Add(tempstr);
end;
// óäàëèòü FigureGroup
RemoveInFigureGrp(NotesCaptions);
aNotesGroup.RemoveFromGrp(NotesCaptions); //28.04.2011 aNotesGroup.InFigures.Remove(NotesCaptions);
FreeAndNil(NotesCaptions);
// Ñîçäàòü è Îáðàáîòàòü RichText
if aIsLine then
RichTextMod := TRichTextMod.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack,
LHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Note)
else
RichTextMod := TRichTextMod.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack,
LHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Note);
RichTextMod.RE.Lines.Clear;
for i := 0 to StrList.Count - 1 do
RichTextMod.re.Lines.Add(StrList.Strings[i]);
GCadForm.PCad.AddCustomFigure(GLN (LHandle), RichTextMod, False);
RefreshCAD(GCadForm.PCad);
xCanvas := TMetafileCanvas.Create(RichTextMod.Metafile, 0);
xCanvas.Font.Name := RichTextMod.re.Font.Name;
xCanvas.Font.Size := RichTextMod.re.Font.Size;
GetTextMetrics(xCanvas.Handle, TM);
h := TM.tmHeight / 4 * RichTextMod.re.Lines.Count + 1;
w := 0;
for i := 0 to RichTextMod.re.Lines.Count - 1 do
begin
if w < xCanvas.TextWidth(RichTextMod.Re.Lines[i]) then
w := xCanvas.TextWidth(RichTextMod.Re.Lines[i]);
end;
w := (w + 3) / 4;
FreeAndNil(xCanvas);
GCadForm.PCad.Figures.Remove(RichTextMod);
FreeAndNil(RichTextMod);
if aIsLine then
RichTextMod := TRichTextMod.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack,
LHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Note)
else
RichTextMod := TRichTextMod.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack,
LHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Note);
RichTextMod.RE.Lines.Clear;
for i := 0 to StrList.Count - 1 do
RichTextMod.re.Lines.Add(StrList.Strings[i]);
RichTextMod.Move(CPoints.x - RichTextMod.CenterPoint.x, CPoints.y - RichTextMod.CenterPoint.y);
RichTextMod.rotate(Angle, RichTextMod.CenterPoint);
aNotesGroup.AddFigure(RichTextMod);
//
FreeAndNil(StrList);
Result := aNotesGroup;
except
on E: Exception do addExceptionToLogEx('U_Common.ConvertCaptionsGroupToRichText', E.Message);
end;
end;
Function GetFiguresByLevel(aFigure: TFigure; X, Y: Double; aSameType: Boolean; ASort: Boolean=false): TList;
var
i: integer;
FFigure: TFigure;
FLine: TOrthoLine;
FConn: TConnectorObject;
CurrLine: TOrthoLine;
CurrConn: TConnectorObject;
function GetItemHeight(AFigure: TFigure): Double;
begin
Result := 0;
if CheckFigureByClassName(AFigure, cTOrthoLine) then
if TOrthoLine(AFigure).ActualZOrder[1] = TOrthoLine(AFigure).ActualZOrder[2] then
Result := TOrthoLine(AFigure).ActualZOrder[1]
else
Result := Min(TOrthoLine(AFigure).ActualZOrder[1], TOrthoLine(AFigure).ActualZOrder[2]);
if CheckFigureByClassName(AFigure, cTConnectorObject) then
Result := TConnectorObject(AFigure).ActualZOrder[1];
end;
function CompareMenuItems(Item1, Item2: Pointer): Integer;
var h1, h2: Double;
begin
Result := 0;
h1 := GetItemHeight(TFigure(Item1));
h2 := GetItemHeight(TFigure(Item2));
if h1 > h2 then
Result := 1
else if h1 < h2 then
Result := -1;
end;
begin
Result := TList.Create;
try
// Òðàññà
if aSameType then
begin
if CheckFigureByClassName(aFigure, cTOrthoLine) then
begin
FLine := TOrthoLine(aFigure);
Result.Add(FLine);
if GCadForm.FNeedUpdateCheckedFigures then
GCadForm.UpdateCheckedFigures;
//for i := 0 to GCadForm.PCad.FigureCount - 1 do
for i := 0 to GCadForm.FCheckedFigures.Count - 1 do
begin
//if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then
if CheckFigureByClassName(TFigure(GCadForm.FCheckedFigures[i]), cTOrthoLine) then
begin
//CurrLine := TOrthoLine(GCadForm.PCad.Figures[i]);
CurrLine := TOrthoLine(GCadForm.FCheckedFigures[i]);
if FLine <> CurrLine then
begin
if CurrLine.IsPointIn(X, Y) then
Result.Add(CurrLine);
end;
end;
end;
end;
// Êîííåêòîð
if CheckFigureByClassName(aFigure, cTConnectorObject) then
begin
FConn := TConnectorObject(aFigure);
Result.Add(FConn);
if GCadForm.FNeedUpdateCheckedFigures then
GCadForm.UpdateCheckedFigures;
//for i := 0 to GCadForm.PCad.FigureCount - 1 do
for i := 0 to GCadForm.FCheckedFigures.Count - 1 do
begin
//if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then
if CheckFigureByClassName(TFigure(GCadForm.FCheckedFigures[i]), cTConnectorObject) then
begin
//CurrConn := TConnectorObject(GCadForm.PCad.Figures[i]);
CurrConn := TConnectorObject(GCadForm.FCheckedFigures[i]);
if FConn <> CurrConn then
begin
if CurrConn.ConnectorType = ct_Clear then
begin
if CurrConn.JoinedConnectorsList.Count = 0 then
if CurrConn.IsPointIn(X, Y) then
Result.Add(CurrConn);
end
else
begin
if CurrConn.IsPointIn(X, Y) then
Result.Add(CurrConn);
end;
end;
end;
end;
end;
end
else
begin
Result.Add(aFigure);
if GCadForm.FNeedUpdateCheckedFigures then
GCadForm.UpdateCheckedFigures;
//for i := 0 to GCadForm.PCad.FigureCount - 1 do
for i := 0 to GCadForm.FCheckedFigures.Count - 1 do
begin
//FFigure := TFigure(GCadForm.PCad.Figures[i]);
FFigure := TFigure(GCadForm.FCheckedFigures[i]);
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
CurrConn := TConnectorObject(FFigure);
if aFigure <> CurrConn then
begin
if CurrConn.ConnectorType = ct_Clear then
begin
if CurrConn.JoinedConnectorsList.Count = 0 then
if CurrConn.IsPointIn(X, Y) then
Result.Add(CurrConn);
end
else
begin
if CurrConn.IsPointIn(X, Y) then
Result.Add(CurrConn);
end;
end;
end;
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
CurrLine := TOrthoLine(FFigure);
if aFigure <> CurrLine then
begin
if CurrLine.IsPointIn(X, Y) then
Result.Add(CurrLine);
end;
end;
end;
end;
if ASort then
Result.Sort(@CompareMenuItems);
except
on E: Exception do addExceptionToLogEx('U_Common.GetFiguresByLevel', E.Message);
end;
end;
Function GetObjectsByVertical(aSelf, aSnapConnector: TConnectorObject): TList;
var
i: integer;
FFigure: TFigure;
FLine: TOrthoLine;
FConn: TConnectorObject;
CurrLine: TOrthoLine;
CurrConn: TConnectorObject;
X, Y, Z: double;
begin
Result := TList.Create;
try
Result.Add(aSnapConnector);
X := aSnapConnector.ActualPoints[1].x;
Y := aSnapConnector.ActualPoints[1].y;
Z := aSelf.ActualZOrder[1];
if GCadForm.FNeedUpdateCheckedFigures then
GCadForm.UpdateCheckedFigures;
//for i := 0 to GCadForm.PCad.FigureCount - 1 do
for i := 0 to GCadForm.FCheckedFigures.Count - 1 do
begin
//FFigure := TFigure(GCadForm.PCad.Figures[i]);
FFigure := TFigure(GCadForm.FCheckedFigures[i]);
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
CurrConn := TConnectorObject(FFigure);
if (CurrConn <> aSelf) and (CurrConn <> aSnapConnector) then
begin
if CurrConn.ConnectorType = ct_Clear then
begin
if CurrConn.JoinedConnectorsList.Count = 0 then
if CurrConn.IsPointIn(X, Y) then
Result.Add(CurrConn);
end
else
begin
if CurrConn.IsPointIn(X, Y) then
Result.Add(CurrConn);
end;
end;
end;
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
CurrLine := TOrthoLine(FFigure);
if CurrLine.FIsVertical then
begin
if CurrLine.IsPointIn(X, Y) then
if CheckVerticalInInterval(CurrLine, Z) then
Result.Add(CurrLine);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetObjectsByVertical', E.Message);
end;
end;
Function GetLinesByVertical(aSelf: TConnectorObject; aSnapLine: TOrthoLine): TList;
var
i: integer;
FFigure: TFigure;
FLine: TOrthoLine;
FConn: TConnectorObject;
CurrLine: TOrthoLine;
CurrConn: TConnectorObject;
X, Y: double;
begin
Result := TList.Create;
try
Result.Add(aSnapLine);
X := aSnapLine.ActualPoints[1].x;
Y := aSnapLine.ActualPoints[1].y;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
FFigure := TFigure(GCadForm.PCad.Figures[i]);
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
CurrLine := TOrthoLine(FFigure);
if CurrLine <> aSnapLine then
if CurrLine.FIsVertical then
begin
if CurrLine.IsPointIn(X, Y) then
Result.Add(CurrLine);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetFiguresByLevel', E.Message);
end;
end;
Function CheckVerticalInInterval(aVertical: TOrthoLine; aZ: Double): Boolean;
var
z1, z2: double;
begin
Result := False;
try
if (aVertical.ActualZOrder[2] > aVertical.ActualZOrder[1]) then
begin
z1 := aVertical.ActualZOrder[1];
z2 := aVertical.ActualZOrder[2];
end
else
begin
z1 := aVertical.ActualZOrder[2];
z2 := aVertical.ActualZOrder[1];
end;
if (aZ >= z1) and (aZ <= z2) then
Result := True;
except
on E: Exception do AddExceptionToLogEx('U_Common.CheckVerticalInInterval', E.Message);
end;
end;
Procedure DeleteRaiseOtherFloor(aItRaise: TConnectorObject);
var
ListOfPassage: TF_CAD;
ConnOfPassage: TConnectorObject;
CurGCadForm: TF_CAD;
SCSFigureGrp: TSCSFigureGrp;
begin
try
ListOfPassage := GetListOfPassage(aItRaise.FID_ListToPassage);
if ListOfPassage <> nil then
begin
ConnOfPassage := TConnectorObject(GetFigureByID(ListOfPassage, aItRaise.FID_ConnToPassage));
if ConnOfPassage <> nil then
begin
CurGCadForm := GCadForm;
GCadForm := ListOfPassage;
ConnOfPassage.FConnRaiseType := crt_None;
ConnOfPassage.Delete(True);
RefreshCAD(GCadForm.PCad);
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_Common.DeleteRaiseOtherFloor', E.Message);
end;
end;
Function MirrorCables(aClearConn: TConnectorObject; aNearTracedLine: TOrthoLine): Integer;
var
i,j: integer;
CurrConn: TConnectorObject;
CurrLine: TOrthoLine;
mess: string;
Count: Integer;
MessBoxResult: Integer;
Side: Integer;
begin
Result := 0;
try
for i := 0 to aClearConn.JoinedOrtholinesList.Count - 1 do
begin
CurrLine := TOrthoLine(aClearConn.JoinedOrtholinesList[i]);
if CurrLine <> aNearTracedLine then
begin
Side := 1; //#From Oleg# //14.09.2010
if CurrLine.JoinConnector1 = aClearConn then
Side := 1;
if CurrLine.JoinConnector2 = aClearConn then
Side := 2;
Count := GetCablesCountFromTrace(CurrLine.ID, Side, GDropComponent.ID);
if count > 1 then
begin
mess := cCommon_Mes16 + IntTostr(Count) + cCommon_Mes17 + #13#10 +
cCommon_Mes18;
MessBoxResult := MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cCommon_Mes19, MB_YESNOCANCEL);
if MessBoxResult = IDYes then
begin
Result := Count;
exit;
end
else
if MessBoxResult = IDNo then
Result := 1;
if MessBoxResult = IDCancel then
exit;
end
else
begin
Result := 1;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.MirrorCables', E.Message);
end;
end;
Function CheckCanTracingBetweenFloor(aLists: TIntList; aRaises: TList): Boolean;
var
i: integer;
begin
Result := True;
try
if aLists.Count <> aRaises.Count + 1 then
Result := False;
for i := 0 to aRaises.Count - 1 do
if aRaises[i] = Nil then
Result := False;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckCanTracingBetweenFloor', E.Message);
end;
end;
Function GetSortedListOfRaises(var aLists: TIntList; aRaiseType: TConnRaiseType; aEndPoint, aBeginPoint: TConnectorObject): TList;
var
i, j: Integer;
RaiseConn: TConnectorObject;
ListID: Integer;
CurCad: TF_CAD;
RaisesList: TList;
ResList: TList;
ListIndex: Integer;
GlobalExit: Boolean;
aRaiseType1, aRaiseType2: TConnRaiseType;
OtherListIndex: Integer;
ResListOfLists: TList;
Procedure DoFindRaises(aCadForm: TF_CAD; aRaiseType: TConnRaiseType; aConnFrom, aConnTo: TConnectorObject; aListIndex: Integer);
var
i, j: integer;
CurrRaise: TConnectorObject;
OtherRaise: TConnectorObject;
OtherCadList: TF_CAD;
RaisesList: TList;
AllTrace: TList;
begin
try
RaisesList := TList.Create;
if aCadForm <> nil then
begin
// åñëè ïîñëåäíèé ëèñò
if aListIndex = ListIndex then
begin
AllTrace := GetAllTraceInCAD(aConnFrom, aBeginPoint);
if AllTrace <> nil then
begin
GlobalExit := True;
Exit;
end;
end
// èíà÷å ñíîâà èñêàòü ñ-ï
else
begin
aRaiseType1 := crt_none;
aRaiseType2 := crt_none;
if aRaiseType = crt_BetweenFloorUp then
begin
aRaiseType1 := crt_BetweenFloorUp;
aRaiseType2 := crt_TrunkUp;
end;
if aRaiseType = crt_BetweenFloorDown then
begin
aRaiseType1 := crt_BetweenFloorDown;
aRaiseType2 := crt_TrunkDown;
end;
for i := 0 to aCadForm.PCad.FigureCount - 1 do
if CheckFigureByClassName(TFigure(aCadForm.PCad.Figures[i]), cTConnectorObject) then
if (TConnectorObject(aCadForm.PCad.Figures[i]).FConnRaiseType = aRaiseType1) or
(TConnectorObject(aCadForm.PCad.Figures[i]).FConnRaiseType = aRaiseType2) then
RaisesList.Add(TConnectorObject(aCadForm.PCad.Figures[i]));
end;
end;
if RaisesList.Count > 0 then
begin
for i := 0 to RaisesList.Count - 1 do
begin
if GlobalExit then
Exit;
CurrRaise := TConnectorObject(RaisesList[i]);
AllTrace := GetAllTraceInCAD(aConnFrom, CurrRaise);
if AllTrace <> nil then
begin
OtherCadList := GetListByID(CurrRaise.FID_ListToPassage);
OtherRaise := TConnectorObject(GetFigureByID(OtherCadList, CurrRaise.FID_ConnToPassage));
if (OtherRaise <> nil) and (OtherCadList <> nil) then
begin
ResList.Add(CurrRaise);
OtherListIndex := aLists.IndexOf(OtherCadList.FCADListID);
// &&&
ResListOfLists.Add(OtherCadList);
// &&&
DoFindRaises(OtherCadList, aRaiseType, OtherRaise, aBeginPoint, OtherListIndex {aListIndex + 1});
end;
end;
end;
end;
begin
if GlobalExit then
Exit;
if ResList.Count > 0 then
ResList.Delete(ResList.Count - 1);
if ResListOfLists.Count > 0 then
ResListOfLists.Delete(ResListOfLists.Count - 1);
Exit;
end;
if RaisesList <> nil then
FreeAndNil(RaisesList);
if AllTrace <> nil then
FreeAndNil(AllTrace);
except
on E: Exception do addExceptionToLogEx('U_Common.GetBetweenFloorRaises', E.Message);
end;
end;
begin
ResList := TList.Create;
try
ResListOfLists := TList.Create;
ListIndex := aLists.Count - 1;
ListID := aLists[0];
CurCad := GetListByID(ListID);
GlobalExit := False;
// &&&
ResListOfLists.Add(CurCad);
// &&&
DoFindRaises(CurCad, aRaiseType, aEndPoint, aBeginPoint, 0);
Result := ResList;
aLists := CadsToIntCads(ResListOfLists);
except
on E: Exception do addExceptionToLogEx('U_Common.GetSortedListOfRaises', E.Message);
end;
end;
// *****************************************************************************
Function GetSortedListOfRaisesFromCurr(var aLists: TIntList; aRaiseType: TConnRaiseType; aBeginPoint, aEndPoint: TConnectorObject): TList;
var
i, j: Integer;
RaiseConn: TConnectorObject;
ListID: Integer;
CurCad: TF_CAD;
RaisesList: TList;
ResList: TList;
ListIndex: Integer;
GlobalExit: Boolean;
aRaiseType1, aRaiseType2: TConnRaiseType;
ResListOfLists: TList;
function GetMarkedCount(aCurrList: TList): Integer;
var
i: Integer;
vFigure: TFigure;
begin
Result := 0;
for i := 0 to aCurrList.Count - 1 do
begin
vFigure := TFigure(aCurrList[i]);
if CheckFigureByClassName(vFigure, cTOrthoLine) then
if TOrthoLine(vFigure).FMarkTracing then
Result := Result + 1;
end;
end;
function GetMaxMarkedCount(aList: TList): Integer;
var
i: Integer;
AllTraces: TList;
MaxMarked: Integer;
CurMarked: Integer;
begin
Result := 0;
try
MaxMarked := 0;
for i := 0 to aList.Count - 1 do
begin
AllTraces := TList(aList[i]);
CurMarked := GetMarkedCount(AllTraces);
if CurMarked > MaxMarked then
MaxMarked := CurMarked;
end;
Result := MaxMarked;
except
on E: Exception do addExceptionToLogEx('U_Common.GetMaxMarkedCount', E.Message);
end;
end;
function GetSortedRaisesByMarked(aCurrConn: TConnectorObject; aRaises: TList): TList;
var
i, j: Integer;
CurrRaise: TConnectorObject;
ListOfAllTraces: TList;
CurMarked, MaxMarked: Integer;
MaxIndex: Integer;
begin
Result := TList.create;
try
i := 0;
while i < aRaises.Count do
begin
CurrRaise := TConnectorObject(aRaises[i]);
ListOfAllTraces := GetAllTraceInCADByMarked(CurrRaise, aCurrConn);
CurMarked := GetMaxMarkedCount(ListOfAllTraces);
MaxMarked := CurMarked;
MaxIndex := 0;
for j := 1 to aRaises.Count - 1 do
begin
CurrRaise := TConnectorObject(aRaises[j]);
ListOfAllTraces := GetAllTraceInCADByMarked(CurrRaise, aCurrConn);
CurMarked := GetMaxMarkedCount(ListOfAllTraces);
if CurMarked > MaxMarked then
begin
MaxMarked := CurMarked;
MaxIndex := j;
end;
end;
Result.Add(aRaises[MaxIndex]);
aRaises.Delete(MaxIndex);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetSortedRaisesByMarked', E.Message);
end;
end;
Procedure DoFindRaises(aCadForm: TF_CAD; aRaiseType: TConnRaiseType; aConnFrom, aConnTo: TConnectorObject; aListIndex: Integer);
var
i, j: integer;
CurrRaise: TConnectorObject;
OtherRaise: TConnectorObject;
OtherCadList: TF_CAD;
RaisesList: TList;
AllTrace: TList;
OtherListIndex: Integer;
begin
try
RaisesList := TList.Create;
if aCadForm <> nil then
begin
// åñëè ïîñëåäíèé ëèñò
if aListIndex = ListIndex then
begin
AllTrace := GetAllTraceInCAD(aConnFrom, aEndPoint);
if AllTrace <> nil then
begin
GlobalExit := True;
Exit;
end;
end
// èíà÷å ñíîâà èñêàòü ñ-ï
else
begin
aRaiseType1 := crt_none;
aRaiseType2 := crt_none;
if aRaiseType = crt_BetweenFloorUp then
begin
aRaiseType1 := crt_BetweenFloorUp;
aRaiseType2 := crt_TrunkUp;
end;
if aRaiseType = crt_BetweenFloorDown then
begin
aRaiseType1 := crt_BetweenFloorDown;
aRaiseType2 := crt_TrunkDown;
end;
for i := 0 to aCadForm.PCad.FigureCount - 1 do
if CheckFigureByClassName(TFigure(aCadForm.PCad.Figures[i]), cTConnectorObject) then
if (TConnectorObject(aCadForm.PCad.Figures[i]).FConnRaiseType = aRaiseType1) or
(TConnectorObject(aCadForm.PCad.Figures[i]).FConnRaiseType = aRaiseType2) then
RaisesList.Add(TConnectorObject(aCadForm.PCad.Figures[i]));
end;
end;
if RaisesList.Count > 0 then
begin
// ýòî ïåðâûé ëèñò, èñêàòü ïî îòìå÷åííûì òðàññàì
if aListIndex = 0 then
begin
RaisesList := GetSortedRaisesByMarked(aConnFrom, RaisesList);
end;
for i := 0 to RaisesList.Count - 1 do
begin
if GlobalExit then
Exit;
CurrRaise := TConnectorObject(RaisesList[i]);
AllTrace := GetAllTraceInCAD(aConnFrom, CurrRaise);
if AllTrace <> nil then
begin
OtherCadList := GetListByID(CurrRaise.FID_ListToPassage);
OtherRaise := TConnectorObject(GetFigureByID(OtherCadList, CurrRaise.FID_ConnToPassage));
if (OtherRaise <> nil) and (OtherCadList <> nil) then
begin
ResList.Add(CurrRaise);
OtherListIndex := aLists.IndexOf(OtherCadList.FCADListID);
// &&&
ResListOfLists.Add(OtherCadList);
// &&&
DoFindRaises(OtherCadList, aRaiseType, OtherRaise, aBeginPoint, OtherListIndex{aListIndex + 1});
end;
end;
end;
end;
begin
if GlobalExit then
Exit;
if ResList.Count > 0 then
ResList.Delete(ResList.Count - 1);
// &&&
if ResListOfLists.Count > 0 then
ResListOfLists.Delete(ResListOfLists.Count - 1);
// &&&
Exit;
end;
if RaisesList <> nil then
FreeAndNil(RaisesList);
if AllTrace <> nil then
FreeAndNil(AllTrace);
except
on E: Exception do addExceptionToLogEx('U_Common.GetBetweenFloorRaises', E.Message);
end;
end;
begin
ResList := TList.Create;
try
ResListOfLists := TList.Create;
ListIndex := aLists.Count - 1;
ListID := aLists[0];
CurCad := GetListByID(ListID);
GlobalExit := False;
// &&&
ResListOfLists.Add(CurCad);
// &&&
DoFindRaises(CurCad, aRaiseType, aBeginPoint, aEndPoint, 0);
Result := ResList;
aLists := CadsToIntCads(ResListOfLists);
except
on E: Exception do addExceptionToLogEx('U_Common.GetSortedListOfRaisesFromCurr', E.Message);
end;
end;
Function IsBetweenFloorObject(AListID, AIDFigure: Integer; var AIDOtherFloorFigure: Integer): Boolean;
var
i, j: Integer;
ItList, OtherList: TF_CAD;
ItRaiseLine, OtherRaiseLine: TFigure;
ItRaiseConn, OtherRaiseConn: TConnectorObject;
begin
Result := False;
try
AIDOtherFloorFigure := -1;
ItList := GetListByID(AListID);
if ItList <> nil then
begin
ItRaiseLine := GetFigureByID(ItList, AIDFigure);
if ItRaiseLine <> nil then
begin
if CheckFigureByClassName(ItRaiseLine, cTOrthoLine) then
begin
if TOrthoLine(ItRaiseLine).FIsRaiseUpDown then
begin
ItRaiseConn := TConnectorObject(TOrthoLine(ItRaiseLine).JoinConnector1);
if (ItRaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (ItRaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (ItRaiseConn.FConnRaiseType = crt_TrunkUp) or (ItRaiseConn.FConnRaiseType = crt_TrunkDown) then
begin
Result := True;
OtherList := GetListByID(ItRaiseConn.FID_ListToPassage);
if OtherList <> nil then
begin
OtherRaiseConn := TConnectorObject(GetFigureByID(OtherList, ItRaiseConn.FID_ConnToPassage));
if OtherRaiseConn <> nil then
begin
for i := 0 to OtherRaiseConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(OtherRaiseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
AIDOtherFloorFigure := TOrthoLine(OtherRaiseConn.JoinedOrtholinesList[i]).ID;
end;
end;
end;
ItRaiseConn := TConnectorObject(TOrthoLine(ItRaiseLine).JoinConnector2);
if (ItRaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (ItRaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (ItRaiseConn.FConnRaiseType = crt_TrunkUp) or (ItRaiseConn.FConnRaiseType = crt_TrunkDown) then
begin
Result := True;
OtherList := GetListByID(ItRaiseConn.FID_ListToPassage);
if OtherList <> nil then
begin
OtherRaiseConn := TConnectorObject(GetFigureByID(OtherList, ItRaiseConn.FID_ConnToPassage));
if OtherRaiseConn <> nil then
begin
for i := 0 to OtherRaiseConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(OtherRaiseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
AIDOtherFloorFigure := TOrthoLine(OtherRaiseConn.JoinedOrtholinesList[i]).ID;
end;
end;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.IsBetweenFloorObject', E.Message);
end;
end;
Function SetCADParamsStruct(aListParams: TListParams): TCADParams;
begin
try
// Âêëàäêà "Îáùèå"
Result.CADHeightRoom := aListParams.Settings.HeightRoom;
Result.CADHeightFalseFloor := aListParams.Settings.HeightCeiling;
Result.CADHeightConns := aListParams.Settings.HeightSocket;
Result.CADHeightLines := aListParams.Settings.HeightCorob;
Result.CADIndexPointObjects := aListParams.IndexPointObj + 1;
Result.CADIndexConnector := aListParams.IndexConnector + 1;
Result.CADIndexLine := aListParams.IndexLine + 1;
// Âêëàäêà "CAD"
Result.CADPageSizeIndex := aListParams.Settings.CADPageSizeIndex;
Result.CADPageOrient := aListParams.Settings.CADPageOrient;
Result.CADStampType := aListParams.Settings.CADStampType;
Result.CADStampLang := aListParams.Settings.CADStampLang;
Result.CADStampMargins := aListParams.Settings.CADStampMargins;
Result.CADWidth := aListParams.Settings.CADWidth;
Result.CADHeight := aListParams.Settings.CADHeight;
Result.CADListCountX := aListParams.Settings.CADListCountX;
Result.CADListCountY := aListParams.Settings.CADListCountY;
Result.CADFontName := aListParams.Settings.CADFontName;
Result.CADGridStep := aListParams.Settings.CADGridStep;
Result.CADShowMainStamp := aListParams.Settings.CADShowMainStamp;
Result.CADShowUpperStamp := aListParams.Settings.CADShowUpperStamp;
Result.CADShowSideStamp := aListParams.Settings.CADShowSideStamp;
//Result.CADShowPathLineType := aListParams.Settings.CADShowPathLineType;
//#From Oleg# //21.09.2010
//try
// if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
// Result.CADMapScale := GCadForm.PCad.MapScale
// else
// Result.CADMapScale := 100;
//except
// Result.CADMapScale := 100;
//end;
Result.CADMapScale := 0; //21.09.2010
Result.CADTraceColor := aListParams.Settings.CADTraceColor;
Result.CADTraceStyle := aListParams.Settings.CADTraceStyle;
Result.CADTraceWidth := aListParams.Settings.CADTraceWidth;
Result.CADBlockStep := aListParams.Settings.CADBlockStep;
Result.CADObjectCaptions := aListParams.Settings.ShowObjectTypeCAD;
Result.CADLinesCaptions := aListParams.Settings.CADCaptionsKind;
Result.CADObjectNotes := aListParams.Settings.CADShowObjectNotesType;
Result.CADLinesNotes := aListParams.Settings.CADNotesKind;
Result.CADNotePrefix := aListParams.Settings.NoteCountPrefix;
Result.CADShowLineObjectCaption := aListParams.Settings.ShowLineObjectCaption;
Result.CADShowLineObjectLength := aListParams.Settings.ShowLineObjectLength;
Result.CADShowLineObjectNote := aListParams.Settings.ShowLineObjectNote;
Result.CADShowConnObjectCaption := aListParams.Settings.ShowConnObjectCaption;
Result.CADShowConnObjectNote := aListParams.Settings.ShowConnObjectNote;
Result.CADShowRaise := aListParams.Settings.CADShowRaise;
Result.CADShowRaiseDrawFigure := aListParams.Settings.CADShowRaiseDrawFigure;
Result.CADPutCableInTrace := aListParams.Settings.PutCableInTrace;
Result.CADLinesCaptionsColor := aListParams.Settings.CADLinesCaptionsColor;
Result.CADConnectorsCaptionsColor := aListParams.Settings.CADConnectorsCaptionsColor;
Result.CADLinesNotesColor := aListParams.Settings.CADLinesNotesColor;
Result.CADConnectorsNotesColor := aListParams.Settings.CADConnectorsNotesColor;
Result.CADLinesCaptionsFontSize := aListParams.Settings.CADLinesCaptionsFontSize;
Result.CADConnectorsCaptionsFontSize := aListParams.Settings.CADConnectorsCaptionsFontSize;
Result.CADLinesNotesFontSize := aListParams.Settings.CADLinesNotesFontSize;
Result.CADConnectorsNotesFontSize := aListParams.Settings.CADConnectorsNotesFontSize;
Result.CADLinesCaptionsFontBold := aListParams.Settings.CADLinesCaptionsFontBold;
Result.CADCrossATSFontSize := aListParams.Settings.CADCrossATSFontSize;
Result.CADCrossATSFontBold := aListParams.Settings.CADCrossATSFontBold;
Result.CADDistribCabFontSize := aListParams.Settings.CADDistribCabFontSize;
Result.CADDistribCabFontBold := aListParams.Settings.CADDistribCabFontBold;
Result.CADPrintType := aListParams.Settings.CADPrintType;
Result.SCSType := aListParams.Settings.SCSType;
Result.CADTraceStepRotate := aListParams.Settings.CADTraceStepRotate;
Result.AutoCadMouse := aListParams.Settings.AutoCadMouse;
Result.ScaleByCursor := aListParams.Settings.ScaleByCursor;
Result.AutoPosTraceBetweenRM := aListParams.Settings.CADAutoPosTraceBetweenRM;
Result.CADSaveUndoCount := aListParams.Settings.CADSaveUndoCount;
Result.CADAllowSupplieskind := aListParams.Settings.CADAllowSuppliesKind;
//11.10.2012
Result.CADNewTraceLengthType := aListParams.Settings.CADNewTraceLengthType;
except
on E: Exception do addExceptionToLogEx('U_Common.SetCADParamsStruct', E.Message);
end;
end;
Procedure CheckByCaptionsNotes(X, Y: Double);
var
i, j: Integer;
CheckCaptionNote: TFigure;
CurrFigure: TFigure;
FindSCSObject: TFigure;
NotesCaptions: TRichTextMod;
begin
try
FindSCSObject := nil;
CheckCaptionNote := GCadForm.PCad.CheckByPoint(0, X, Y);
// Caption
if CheckCaptionNote <> nil then
begin
if CheckFigureByClassName(CheckCaptionNote, cTRichTextMod) then
begin
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
CurrFigure := TFigure(GCadForm.PCad.Figures[i]);
if CheckFigureByClassName(CurrFigure, cTConnectorObject) then
if TConnectorObject(CurrFigure).CaptionsGroup <> nil then
if TConnectorObject(CurrFigure).CaptionsGroup.ID = CheckCaptionNote.ID then
FindSCSObject := CurrFigure;
if CheckFigureByClassName(CurrFigure, cTOrthoLine) then
if TOrthoLine(CurrFigure).CaptionsGroup <> nil then
if TOrthoLine(CurrFigure).CaptionsGroup.ID = CheckCaptionNote.ID then
FindSCSObject := CurrFigure;
end;
if FindSCSObject <> nil then
begin
FSCS_Main.aViewSCSObjectsProp.Checked := True;
CheckCaptionNote.Deselect;
OpenCaptionAtPos(FindSCSObject, TRichTextMod(CheckCaptionNote), X, Y);
end;
end;
// Note
if CheckFigureByClassName(CheckCaptionNote, cTFigureGrpNotMod) then
begin
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
CurrFigure := TFigure(GCadForm.PCad.Figures[i]);
if CheckFigureByClassName(CurrFigure, cTConnectorObject) then
if TConnectorObject(CurrFigure).NotesGroup <> nil then
if TConnectorObject(CurrFigure).NotesGroup.ID = CheckCaptionNote.ID then
begin
NotesCaptions := TRichTextMod(TFigureGrpNotMod(CheckCaptionNote).InFigures[1]);
if NotesCaptions.isPointIn(X, Y) then
FindSCSObject := CurrFigure;
end;
if CheckFigureByClassName(CurrFigure, cTOrthoLine) then
if TOrthoLine(CurrFigure).NotesGroup <> nil then
if TOrthoLine(CurrFigure).NotesGroup.ID = CheckCaptionNote.ID then
begin
NotesCaptions := TRichTextMod(TFigureGrpNotMod(CheckCaptionNote).InFigures[1]);
if NotesCaptions.isPointIn(X, Y) then
FindSCSObject := CurrFigure;
end;
end;
if FindSCSObject <> nil then
begin
FSCS_Main.aViewSCSObjectsProp.Checked := True;
CheckCaptionNote.Deselect;
OpenNoteAtPos(FindSCSObject, TRichTextMod(TFigureGrpNotMod(CheckCaptionNote).InFigures[1]), X, Y);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckByCaptionsNotes', E.Message);
end;
end;
Procedure OpenCaptionAtPos(aObject: TFigure; aCaption: TRichTextMod; X, Y: Double);
var
i: Integer;
Point: TPoint;
Bnd: TDoubleRect;
y1, y2: Double;
height: double;
Count: Integer;
ItemSize: Double;
DeltaPos: Double;
SelItem: Integer;
StartPos: Integer;
begin
try
aObject.Select;
RefreshCAD(GCadForm.PCad);
GetCursorPos(Point);
F_SCSObjectsProp.Left := Point.X;
F_SCSObjectsProp.Top := Point.Y;
F_SCSObjectsProp.Show;
Bnd := aCaption.GetBoundRect;
y1 := Bnd.Top;
y2 := Bnd.Bottom;
height := abs(Bnd.Bottom - Bnd.Top);
Count := aCaption.re.Lines.Count;
ItemSize := height / Count;
DeltaPos := abs(Y - y1);
SelItem := Round(DeltaPos / ItemSize);
if CheckFigureByClassName(aObject, cTConnectorObject) then
begin
F_SCSObjectsProp.PageSCSObjects.ActivePageIndex := 0;
F_SCSObjectsProp.ConnectorPropertiesForNormal(TConnectorObject(aObject).ConnectorType);
F_SCSObjectsProp.LoadConnectorProperties(TConnectorObject(aObject));
F_SCSObjectsProp.bConnOK.Enabled := True;
if F_SCSObjectsProp.mConnCaptionsGroup.Enabled then
begin
F_SCSObjectsProp.mConnCaptionsGroup.SetFocus;
F_SCSObjectsProp.mConnCaptionsGroup.SelStart := 0;
F_SCSObjectsProp.mConnCaptionsGroup.SelLength := 0;
StartPos := 0;
for i := 0 to SelItem - 1 do
begin
StartPos := StartPos + Length(F_SCSObjectsProp.mConnCaptionsGroup.Lines[i]);
StartPos := StartPos + 2;
end;
F_SCSObjectsProp.mConnCaptionsGroup.SelStart := StartPos;
if SelItem >= 0 then
F_SCSObjectsProp.mConnCaptionsGroup.SelLength := length(F_SCSObjectsProp.mConnCaptionsGroup.Lines[SelItem]) + 1;
end;
end;
if CheckFigureByClassName(aObject, cTOrthoLine) then
begin
F_SCSObjectsProp.PageSCSObjects.ActivePageIndex := 1;
// åñëè ýòî ñ-ï
if TOrthoLine(aObject).FIsRaiseUpDown then
begin
F_SCSObjectsProp.OrtholinePropertiesForRaise;
end
else
begin
F_SCSObjectsProp.OrtholinePropertiesForNormal;
end;
F_SCSObjectsProp.LoadOrtholineProperties(TOrthoLine(aObject));
F_SCSObjectsProp.bLineOK.Enabled := True;
if F_SCSObjectsProp.mLineCaptionsGroup.Enabled then
begin
if TOrthoLine(aObject).ShowLength then
SelItem := SelItem - 1;
F_SCSObjectsProp.mLineCaptionsGroup.SetFocus;
F_SCSObjectsProp.mLineCaptionsGroup.SelStart := 0;
F_SCSObjectsProp.mLineCaptionsGroup.SelLength := 0;
StartPos := 0;
for i := 0 to SelItem - 1 do
begin
StartPos := StartPos + Length(F_SCSObjectsProp.mLineCaptionsGroup.Lines[i]);
StartPos := StartPos + 2;
end;
F_SCSObjectsProp.mLineCaptionsGroup.SelStart := StartPos;
if SelItem >= 0 then
F_SCSObjectsProp.mLineCaptionsGroup.SelLength := length(F_SCSObjectsProp.mLineCaptionsGroup.Lines[SelItem]) + 1;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.OpenCaptionAtPos', E.Message);
end;
end;
Procedure OpenNoteAtPos(aObject: TFigure; aNote: TRichTextMod; X, Y: Double);
var
i: Integer;
Point: TPoint;
Bnd: TDoubleRect;
y1, y2: Double;
height: double;
Count: Integer;
ItemSize: Double;
DeltaPos: Double;
SelItem: Integer;
StartPos: Integer;
begin
try
aObject.Select;
RefreshCAD(GCadForm.PCad);
GetCursorPos(Point);
F_SCSObjectsProp.Left := Point.X;
F_SCSObjectsProp.Top := Point.Y;
F_SCSObjectsProp.Show;
Bnd := aNote.GetBoundRect;
y1 := Bnd.Top;
y2 := Bnd.Bottom;
height := abs(Bnd.Bottom - Bnd.Top);
Count := aNote.re.Lines.Count;
ItemSize := height / Count;
DeltaPos := abs(Y - y1);
SelItem := Round(DeltaPos / ItemSize);
if CheckFigureByClassName(aObject, cTConnectorObject) then
begin
F_SCSObjectsProp.PageSCSObjects.ActivePageIndex := 0;
F_SCSObjectsProp.ConnectorPropertiesForNormal(TConnectorObject(aObject).ConnectorType);
F_SCSObjectsProp.LoadConnectorProperties(TConnectorObject(aObject));
F_SCSObjectsProp.bConnOK.Enabled := True;
if F_SCSObjectsProp.mConnCaptionsGroup.Enabled then
begin
F_SCSObjectsProp.mConnNotesGroup.SetFocus;
F_SCSObjectsProp.mConnNotesGroup.SelStart := 0;
F_SCSObjectsProp.mConnNotesGroup.SelLength := 0;
StartPos := 0;
for i := 0 to SelItem - 1 do
begin
StartPos := StartPos + Length(F_SCSObjectsProp.mConnNotesGroup.Lines[i]);
StartPos := StartPos + 2;
end;
F_SCSObjectsProp.mConnNotesGroup.SelStart := StartPos;
if SelItem >= 0 then
F_SCSObjectsProp.mConnNotesGroup.SelLength := length(F_SCSObjectsProp.mConnNotesGroup.Lines[SelItem]) + 1;
end;
end;
if CheckFigureByClassName(aObject, cTOrthoLine) then
begin
F_SCSObjectsProp.PageSCSObjects.ActivePageIndex := 1;
// åñëè ýòî ñ-ï
if TOrthoLine(aObject).FIsRaiseUpDown then
begin
F_SCSObjectsProp.OrtholinePropertiesForRaise;
end
else
begin
F_SCSObjectsProp.OrtholinePropertiesForNormal;
end;
F_SCSObjectsProp.LoadOrtholineProperties(TOrthoLine(aObject));
F_SCSObjectsProp.bLineOK.Enabled := True;
if F_SCSObjectsProp.mLineNotesGroup.Enabled then
begin
F_SCSObjectsProp.mLineNotesGroup.SetFocus;
F_SCSObjectsProp.mLineNotesGroup.SelStart := 0;
F_SCSObjectsProp.mLineNotesGroup.SelLength := 0;
StartPos := 0;
for i := 0 to SelItem - 1 do
begin
StartPos := StartPos + Length(F_SCSObjectsProp.mLineNotesGroup.Lines[i]);
StartPos := StartPos + 2;
end;
F_SCSObjectsProp.mLineNotesGroup.SelStart := StartPos;
if SelItem >= 0 then
F_SCSObjectsProp.mLineNotesGroup.SelLength := length(F_SCSObjectsProp.mLineNotesGroup.Lines[SelItem]) + 1;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.OpenNotesAtPos', E.Message);
end;
end;
procedure ModifyConnNoteAfterMove(aConn: TConnectorObject; aDeltaX, aDeltaY: Double);
var
NotesRows: TFigureGrpNotMod;
Row1: TLine;
Row2: TLine;
ConnX, ConnY: Double;
ResPointX, ResPointY: Double;
begin
try
NotesRows := TFigureGrpNotMod(aConn.NotesGroup.InFigures[0]);
Row1 := TLine(NotesRows.InFigures[0]);
Row2 := TLine(NotesRows.InFigures[1]);
// ïåðåðèñîâàòü ñòðåëêè
Row2.ActualPoints[1] := DoublePoint(Row2.ActualPoints[1].x + adeltax, Row2.ActualPoints[1].y + adeltay);
Row2.ActualPoints[2] := DoublePoint(Row2.ActualPoints[2].x + adeltax, Row2.ActualPoints[2].y + adeltay);
Row1.ActualPoints[2] := Row2.ActualPoints[1];
// óñòàíîâèòü íîâûé òèï îòîáðàæåíèÿ ñòðåëêè
ConnX := aConn.ActualPoints[1].x;
ConnY := aConn.ActualPoints[1].y;
ResPointX := Row1.ActualPoints[2].x;
ResPointY := Row1.ActualPoints[2].y;
if ResPointX >= ConnX then
begin
if ResPointY <= ConnY then
aConn.FNotesRowsType := nr_UpRightSide
else
if ResPointY > ConnY then
aConn.FNotesRowsType := nr_DownRightSide;
end
else
if ResPointX < ConnX then
begin
if ResPointY >= ConnY then
aConn.FNotesRowsType := nr_DownLeftSide
else
if ResPointY < ConnY then
aConn.FNotesRowsType := nr_UpLeftSide;
end;
aConn.ReCreateNotesGroup(True);
except
on E: Exception do addExceptionToLogEx('U_Common.ModifyConnNoteAfterMove', E.Message);
end;
end;
procedure ModifyLineNoteAfterMove(aLine: TOrthoLine; aDeltaX, aDeltaY: Double);
var
NotesRows: TFigureGrpNotMod;
Row1: TLine;
Row2: TLine;
Row3: TLine;
LineX, LineY: Double;
ResPointX, ResPointY: Double;
begin
try
NotesRows := TFigureGrpNotMod(aLine.NotesGroup.InFigures[0]);
Row1 := TLine(NotesRows.InFigures[0]);
Row2 := TLine(NotesRows.InFigures[1]);
Row3 := TLine(NotesRows.InFigures[2]);
// ïåðåðèñîâàòü ñòðåëêè
Row3.ActualPoints[1] := DoublePoint(Row3.ActualPoints[1].x + adeltax, Row3.ActualPoints[1].y + adeltay);
Row3.ActualPoints[2] := DoublePoint(Row3.ActualPoints[2].x + adeltax, Row3.ActualPoints[2].y + adeltay);
Row2.ActualPoints[2] := Row3.ActualPoints[1];
// óñòàíîâèòü íîâûé òèï îòîáðàæåíèÿ ñòðåëêè
LineX := Row2.ActualPoints[1].x;
LineY := Row2.ActualPoints[1].y;
ResPointX := Row2.ActualPoints[2].x;
ResPointY := Row2.ActualPoints[2].y;
if ResPointX >= LineX then
begin
if ResPointY <= LineY then
aLine.FNotesRowsType := nr_UpRightSide
else
if ResPointY > LineY then
aLine.FNotesRowsType := nr_DownRightSide;
end
else
if ResPointX < LineX then
begin
if ResPointY >= LineY then
aLine.FNotesRowsType := nr_DownLeftSide
else
if ResPointY < LineY then
aLine.FNotesRowsType := nr_UpLeftSide;
end;
aLine.ReCreateNotesGroup(True);
except
on E: Exception do addExceptionToLogEx('U_Common.ModifyLineNoteAfterMove', E.Message);
end;
end;
procedure SetFigureCoordZ(AIDList, AIDFigure: Integer; ACoordZ: Double);
var
vList: TF_CAD;
SavedCadForm: TF_CAD;
FFigure: TFigure;
FConn: TConnectorObject;
FLine: TOrthoLine;
ObjFromRaise: TConnectorObject;
mess: string;
begin
vList := GetListByID(AIDList);
if vList <> nil then
begin
FFigure := GetFigureByID(vList, AIDFigure);
if FFigure <> nil then
begin
SavedCadForm := GCadForm;
GCadForm := vList;
// RT
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
FConn := TConnectorObject(FFigure);
// åñëè âûñîòû íå ñîâïàäàþò - ïðèìåíèòü
if FConn.ActualZOrder[1] <> ACoordZ then
begin
if ACoordZ <> - 1 then
FConn.ActualZOrder[1] := ACoordZ
else
FConn.ActualZOrder[1] := vList.FConnHeight;
// =================
// Îí íå ñ-ï è íà íåì íåò ñ-ï
if (FConn.FConnRaiseType = crt_None) and (GetRaiseConn(FConn) = nil) then
begin
if FConn.JoinedConnectorsList.Count = 0 then
begin
SetConFigureCoordZInPM(FConn.ID, FConn.ActualZOrder[1]);
end
else
CreateRaiseOnPointObject(FConn, FConn.ActualZOrder[1]);
end
else
// íà íåì åñòü ñ-ï
if GetRaiseConn(FConn) <> nil then
begin
// òîëüêî ïîäúåì-ñïóñê
begin
if FConn.JoinedConnectorsList.Count = 0 then
begin
SetConFigureCoordZInPM(FConn.ID, FConn.ActualZOrder[1]);
end
else
ChangeRaiseOnPointObject(FConn, FConn.ActualZOrder[1]);
end;
end
else
// ýòî ñ-ï
if (FConn.FConnRaiseType = crt_OnFloor) then
begin
ObjFromRaise := FConn.FObjectFromRaise;
if FConn.ActualZOrder[1] = ObjFromRaise.ActualZOrder[1] then
begin
mess := cSCSObjectProp_Mes1;
if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cSCSObjectProp_Mes2, MB_YESNO) = IDYes then
begin
if ObjFromRaise.ConnectorType = ct_Clear then
DestroyRaiseOnConnector(ObjFromRaise)
else
DestroyRaiseOnPointObject(ObjFromRaise);
end;
end;
end;
end;
end;
// LINE
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
FLine := TOrthoLine(FFigure);
if not FLine.FIsRaiseUpDown then
begin
// åñëè âûñîòû íå ñîâïàäàþò - ïðèìåíèòü
if (FLine.ActualZOrder[1] <> ACoordZ) or (FLine.ActualZOrder[2] <> ACoordZ) then
begin
if ACoordZ <> -1 then
RaiseLineOnHeight(FLine, ACoordZ, nil)
else
RaiseLineOnHeight(FLine, vList.FLineHeight, nil)
end;
end;
end;
GCadForm := SavedCadForm;
end;
end;
end;
Function GetRaiseType(aObjFromRaise, aRaise: TConnectorObject): TLineRaiseType;
var
BaseHeight: Double;
Height1: Double;
Height2: Double;
DeltaBaseDown, DeltaBaseUp: Double;
begin
Result := lrt_None;
try
DeltaBaseDown := 0; //#From Oleg# //14.09.2010
DeltaBaseUp := 0; //#From Oleg# //14.09.2010
BaseHeight := GCadForm.FLineHeight;
Height1 := aObjFromRaise.ActualZOrder[1];
Height2 := aRaise.ActualZOrder[1];
if Height1 <> Height2 then
begin
// Îäèí èç îáúåêòîâ íà áàçîâîé âûñîòîé
if (Height1 = BaseHeight) or (Height2 = BaseHeight) then
begin
if Height1 = BaseHeight then
begin
if Height2 > BaseHeight then
Result := lrt_Up;
if Height2 < BaseHeight then
Result := lrt_Down;
end;
if Height2 = BaseHeight then
begin
if Height1 > BaseHeight then
Result := lrt_Up;
if Height1 < BaseHeight then
Result := lrt_Down;
end;
end
else
// âíå áàçîâîé âûñîòû
begin
// îáà âûøå áàçû
if (Height1 > BaseHeight) and (Height2 > BaseHeight) then
begin
Result := lrt_Up;
end
else
// îáà íèæå áàçû
if (Height1 < BaseHeight) and (Height2 < BaseHeight) then
begin
Result := lrt_Down;
end
else
// ïî ðàçíûå ñòîðîíû áàçû
if ((Height1 > BaseHeight) and (Height2 < BaseHeight)) or
((Height1 < BaseHeight) and (Height2 > BaseHeight)) then
begin
// delta íàä áàçîâûì óðîâíåì
if Height1 > BaseHeight then
DeltaBaseUp := abs(BaseHeight - Height1);
if Height2 > BaseHeight then
DeltaBaseUp := abs(BaseHeight - Height2);
// delta ïîä áàçîâûì óðîâíåì
if Height1 < BaseHeight then
DeltaBaseDown := abs(BaseHeight - Height1);
if Height2 < BaseHeight then
DeltaBaseDown := abs(BaseHeight - Height2);
//
if DeltaBaseUp >= DeltaBaseDown then
Result := lrt_Up
else
Result := lrt_Down;
end;
end;
end
else
Result := lrt_Up;
except
on E: Exception do addExceptionToLogEx('U_Common.GetRaiseType', E.Message);
end;
end;
function GetLineCaptionFormat(aLine: TOrthoLine; aShowKind: TShowKind): string;
var
str: string;
DblLen: Double;
StrLen: String;
DblHeight: Double;
StrHeight: String;
begin
try
Result := '';
DblLen := aLine.LineLength;
StrLen := FormatFloat(ffMask, MetreToUOM(DblLen));
if aShowKind = skSimple then
begin
if aLine.FIsRaiseUpDown then
begin
if aLine.FLineRaiseType = lrt_Down then
Result := '-' + StrLen
else
Result := StrLen;
end
else
Result := StrLen;
end;
if aShowKind = skdetail then
begin
if aLine.FIsRaiseUpDown then
begin
DblHeight := aLine.FObjectFromRaisedLine.ActualZOrder[1];
StrHeight := FormatFloat(ffMask, MetreToUOM(DblHeight));
if aLine.FLineRaiseType = lrt_Down then
Result := '-' + StrLen + '/' + StrHeight
else
Result := StrLen + '/' + StrHeight;
end
else
begin
if aLine.ActualZOrder[1] = aLine.ActualZOrder[2] then
begin
DblHeight := aLine.ActualZOrder[1];
StrHeight := FormatFloat(ffMask, MetreToUOM(DblHeight));
Result := StrLen + '/' + StrHeight;
end
else
Result := StrLen;
end;
end;
if aShowKind = skExternalSCS then
begin
StrLen := FormatFloat(ffMask, MetreToUOM(DblLen));
Result := '-' + StrLen + '-';
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetLineCaptionFormat', E.Message);
end;
end;
Function GetFullFigureName(aFigure: TFigure; x: Double=-1; y: Double=-1): string;
var
strName: string;
strIndex: string;
ChildObject: TObject;
begin
try
Result := '';
Result := aFigure.Name;
if CheckFigureByClassName(aFigure, cTConnectorObject) then
begin
strName := TConnectorObject(aFigure).Name;
strIndex := IntToStr(TConnectorObject(aFigure).FIndex);
Result := strName + strIndex;
end;
if CheckFigureByClassName(aFigure, cTOrthoLine) then
begin
strName := TOrthoLine(aFigure).Name;
{$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)}
Result := strName;
{$ELSE}
strIndex := IntToStr(TOrthoLine(aFigure).FIndex);
Result := strName + strIndex;
{$IFEND}
end
else if aFigure is TNet then
begin
ChildObject := nil;
if (x<>-1) and (y<>-1) then
ChildObject := TNet(aFigure).GetObjInPoint(x,y)
else if aFigure.Selected then
ChildObject := TNet(aFigure).GetSelectedObject;
Result := GetArchCADObjCaption(aFigure, ChildObject, cMain_Mes107);
//if ChildObject <> aFigure then
//begin
// ChildName := GetArchCADObjCaption(ChildObject, '');
// if ChildName <> '' then
// begin
// if Result <> '' then
// Result := Result + ', ';
// Result := Result + ChildName;
// end;
//end;
end;
except
// on E: Exception do addExceptionToLogEx('U_Common.GetFullFigureName', E.Message);
end;
end;
function GetFullFigureLenName(aFigure: TFigure; x: Double=-1; y: Double=-1): string;
var
ChildObject: TObject;
begin
Result := '';
if aFigure is TNet then
begin
ChildObject := nil;
if (x<>-1) and (y<>-1) then
ChildObject := TNet(aFigure).GetObjInPoint(x,y)
else if aFigure.Selected then
ChildObject := TNet(aFigure).GetSelectedObject;
Result := GetArchCADObjLenCaption(aFigure, ChildObject);
end;
end;
Procedure AutoDisconnectOverRaiseInCAD(AConnector, ARaiseConnector: TConnectorObject; ARaiseLine: TOrthoLine);
var
Connector: TConnectorObject;
RaiseConnector: TConnectorObject;
JoinedConn: TConnectorObject;
ConnectedLines: TList;
ConnectedBeforeRaise: TList;
ConnectedAfterRaise: TList;
procedure DefineConnectedObjectParams(ATargetConnectedObjectParams: TList; AConnectorObject: TConnectorObject);
var
i, j: Integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
ptrConnectObjParam: PConnectObjectParam;
begin
try
New(ptrConnectObjParam);
ptrConnectObjParam.IDObject := AConnectorObject.ID;
ptrConnectObjParam.Side := 0;
ATargetConnectedObjectParams.Add(ptrConnectObjParam);
if AConnectorObject.ConnectorType = ct_Clear then
for i := 0 to AConnectorObject.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnectorObject.JoinedOrtholinesList[i]);
if JoinedLine <> ARaiseLine then
begin
New(ptrConnectObjParam);
ptrConnectObjParam.IDObject := JoinedLine.ID;
if JoinedLine.JoinConnector1 = AConnectorObject then
ptrConnectObjParam.Side := 1;
if JoinedLine.JoinConnector2 = AConnectorObject then
ptrConnectObjParam.Side := 2;
ATargetConnectedObjectParams.Add(ptrConnectObjParam);
end;
end
else
begin
for i := 0 to AConnectorObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(AConnectorObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
if JoinedLine <> ARaiseLine then
begin
New(ptrConnectObjParam);
ptrConnectObjParam.IDObject := JoinedLine.ID;
if JoinedLine.JoinConnector1 = JoinedConn then
ptrConnectObjParam.Side := 1;
if JoinedLine.JoinConnector2 = JoinedConn then
ptrConnectObjParam.Side := 2;
ATargetConnectedObjectParams.Add(ptrConnectObjParam);
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.DefineConnectedObjectParams', E.Message);
end;
end;
begin
try
ConnectedBeforeRaise := TList.Create;
ConnectedAfterRaise := TList.Create;
Connector := AConnector;
RaiseConnector := ARaiseConnector;
if (ARaiseConnector.FConnRaiseType = crt_None) and (AConnector.FConnRaiseType <> crt_None) then
begin
Connector := ARaiseConnector;
RaiseConnector := AConnector;
end;
// AConnector
DefineConnectedObjectParams(ConnectedBeforeRaise, Connector);
// ARaiseConnector
DefineConnectedObjectParams(ConnectedAfterRaise, RaiseConnector);
AutoDisconnectOverRaiseLine(ARaiseLine.ID, ConnectedBeforeRaise, ConnectedAfterRaise);
if ConnectedBeforeRaise <> nil then
FreeList(ConnectedBeforeRaise);
if ConnectedAfterRaise <> nil then
FreeList(ConnectedAfterRaise);
except
on E: Exception do addExceptionToLogEx('U_Common.AutoDisconnectOverRaiseInCAD', E.Message);
end;
end;
Procedure EditBlockOnCAD(aActiveBlockStream, aProjectBlockStream: TMemoryStream);
var
ActBlockFileName, ProjBlockFileName: string;
BlockFig: TBlock;
i: integer;
Bnd: TDoubleRect;
x, y: double;
begin
try
{$if Defined(ES_GRAPH_SC)}
ActBlockFileName := ExeDir + '\.blk\ActBlockTempStream.blk';
ProjBlockFileName := ExeDir + '\.blk\ProjBlockTempStream.blk';
{$else}
ActBlockFileName := ExtractFileDir(Application.ExeName) + '\.blk\ActBlockTempStream.blk';
ProjBlockFileName := ExtractFileDir(Application.ExeName) + '\.blk\ProjBlockTempStream.blk';
{$ifend}
if aActiveBlockStream <> nil then
begin
aActiveBlockStream.SaveToFile(ActBlockFileName);
GCadForm.CurrentLayer := 1;
BlockFig := TBlock(GCadForm.PCad.InsertBlockwithFileName(1, ActBlockFileName, 0, 0));
Bnd := BlockFig.GetBoundRect;
x := abs(Bnd.Right - Bnd.Left);
y := abs(Bnd.Bottom - Bnd.Top);
BlockFig.move(x / 2, y / 2);
end;
if aProjectBlockStream <> nil then
begin
aProjectBlockStream.SaveToFile(ProjBlockFileName);
GCadForm.CurrentLayer := 1;
BlockFig := TBlock(GCadForm.PCad.InsertBlockwithFileName(1, ProjBlockFileName, 10, 0));
Bnd := BlockFig.GetBoundRect;
x := abs(Bnd.Right - Bnd.Left);
y := abs(Bnd.Bottom - Bnd.Top);
BlockFig.move(x / 2, y / 2);
end;
RefreshCAD(GCadForm.PCad);
if FileExists(ActBlockFileName) then
DeleteFile(ActBlockFileName);
if FileExists(ProjBlockFileName) then
DeleteFile(ProjBlockFileName);
except
on E: Exception do addExceptionToLogEx('U_Common.EditBlockOnCAD', E.Message);
end;
end;
procedure RemoveRMWithRM(aRM1, aRM2: TConnectorObject);
var
i, j: integer;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
ConnectedConn: TConnectorObject;
ConnectedList: TList;
begin
try
ConnectedConn := nil; //#From Oleg# //14.09.2010
ConnectedList := TList.Create;
// îïð. ñâÿçóþøèé ñ ñ-ï
for i := 0 to aRM1.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(aRM1.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then
ConnectedConn := JoinedConn;
end;
if ConnectedConn = nil then
Exit;
// ñîõðàíèòü êîííåêòîðû
for i := 0 to aRM1.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(aRM1.JoinedConnectorsList[i]);
ConnectedList.Add(JoinedConn);
end;
DublicateObjectComponents(aRM1.ID, aRM2.ID);
// îòâÿçàòü âñå
for i := 0 to ConnectedList.Count - 1 do
begin
JoinedConn := TConnectorObject(ConnectedList[i]);
UnsnapConnectorFromPointObject(JoinedConn, aRM1);
end;
for i := 0 to ConnectedList.Count - 1 do
begin
JoinedConn := TConnectorObject(ConnectedList[i]);
if JoinedConn <> ConnectedConn then
begin
SnapConnectorToConnector(ConnectedConn, JoinedConn);
// ConnectedConn := JoinedConn;
end;
end;
ConnectedConn.FConnRaiseType := aRM1.FConnRaiseType;
ConnectedConn.FObjectFromRaise := aRM1.FObjectFromRaise;
if aRM2.FObjectFromRaise = aRM1 then
aRM2.FObjectFromRaise := ConnectedConn;
for i := 0 to aRM2.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(aRM2.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then
if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FObjectFromRaisedLine = aRM1 then
TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FObjectFromRaisedLine := ConnectedConn;
end;
end;
aRM1.FConnRaiseType := crt_None;
aRM1.FObjectFromRaise := nil;
aRM1.Delete(False, False);
RefreshCAD(GCadForm.PCad);
FreeAndNil(ConnectedList);
if aRM2.FConnRaiseType <> crt_None then
begin
ReverseRaise(aRM2);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.RemoveRMWithRM', E.Message);
end;
end;
procedure RemoveRMWithClear(aRM, aClear: TConnectorObject);
var
i, j: integer;
JoinedConn: TConnectorObject;
ConnectedConn: TConnectorObject;
ConnectedList: TList;
TestLine: TOrthoLine;
begin
try
ConnectedConn := nil; //#From Oleg# //14.09.2010
ConnectedList := TList.Create;
// îïð. ñâÿçóþøèé ñ ñ-ï
for i := 0 to aRM.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(aRM.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then
ConnectedConn := JoinedConn;
end;
if ConnectedConn = nil then
Exit;
// ñîõðàíèòü êîííåêòîðû
for i := 0 to aRM.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(aRM.JoinedConnectorsList[i]);
ConnectedList.Add(JoinedConn);
end;
// îòâÿçàòü âñå
for i := 0 to ConnectedList.Count - 1 do
begin
JoinedConn := TConnectorObject(ConnectedList[i]);
UnsnapConnectorFromPointObject(JoinedConn, aRM);
end;
for i := 0 to ConnectedList.Count - 1 do
begin
JoinedConn := TConnectorObject(ConnectedList[i]);
if JoinedConn <> ConnectedConn then
begin
SnapConnectorToConnector(ConnectedConn, JoinedConn);
// ConnectedConn := JoinedConn;
end;
end;
ConnectedConn.FConnRaiseType := aRM.FConnRaiseType;
if aClear.FObjectFromRaise = aRM then
aClear.FObjectFromRaise := ConnectedConn;
for i := 0 to aClear.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(aClear.JoinedOrtholinesList[i]).FIsRaiseUpDown then
if TOrthoLine(aClear.JoinedOrtholinesList[i]).FObjectFromRaisedLine = aRM then
TOrthoLine(aClear.JoinedOrtholinesList[i]).FObjectFromRaisedLine := ConnectedConn;
aRM.FConnRaiseType := crt_None;
aRM.FObjectFromRaise := nil;
SnapPointObjectToConnector(aRM, aClear);
aClear.LockMove := False;
aClear.LockModify := False;
aClear.Move(aRM.ActualPoints[1].x - aClear.ActualPoints[1].x, aRM.ActualPoints[1].y - aClear.ActualPoints[1].y);
RefreshCAD(GCadForm.PCad);
FreeAndNil(ConnectedList);
if aRM.FConnRaiseType <> crt_None then
begin
ReverseRaise(aRM);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.RemoveRMWithClear', E.Message);
end;
end;
procedure ReverseRaise(aPointObject: TConnectorObject);
var
i: integer;
ObjFromRaise: TConnectorObject;
RaiseLine: TOrthoLine;
ObjParams: TObjectParams;
begin
try
RaiseLine := nil; //#From Oleg# //14.09.2010
if aPointObject.FObjectFromRaise = nil then
Exit;
if aPointObject.FObjectFromRaise.ConnectorType <> ct_Clear then
Exit;
ObjFromRaise := aPointObject.FObjectFromRaise;
ObjFromRaise.FConnRaiseType := aPointObject.FConnRaiseType;
aPointObject.FConnRaiseType := crt_None;
ObjFromRaise.FObjectFromRaise := aPointObject;
aPointObject.FObjectFromRaise := nil;
ObjFromRaise.LockModify := True;
ObjFromRaise.LockMove := True;
aPointObject.LockModify := False;
aPointObject.LockMove := False;
for i := 0 to ObjFromRaise.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(ObjFromRaise.JoinedOrtholinesList[i]).FIsRaiseUpDown then
begin
RaiseLine := TOrthoLine(ObjFromRaise.JoinedOrtholinesList[i]);
if RaiseLine.FObjectFromRaisedLine = ObjFromRaise then
RaiseLine.FObjectFromRaisedLine := aPointObject;
end;
if RaiseLine <> nil then
begin
RaiseLine.ReCreateCaptionsGroup(false, true);
RaiseLine.ReCreateNotesGroup;
end;
ObjFromRaise.Name := cCadClasses_Mes24;
SetNewObjectNameInPM(ObjFromRaise.ID, ObjFromRaise.Name);
ObjParams := GetFigureParams(ObjFromRaise.ID);
ObjFromRaise.Name := ObjParams.Name;
ObjFromRaise.FIndex := ObjParams.MarkID;
GMoveWithRaise := False;
ObjFromRaise.Move(aPointObject.ActualPoints[1].x - ObjFromRaise.ActualPoints[1].x, aPointObject.ActualPoints[1].y - ObjFromRaise.ActualPoints[1].y);
GMoveWithRaise := True;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.ReverseRaise', E.Message);
end;
end;
function CheckListNormalType(aListID: Integer): Boolean;
var
List: TF_CAD;
begin
Result := False;
try
List := GetListByID(aListID);
if List <> nil then
begin
if List.FListType = lt_Normal then
Result := True
else
Result := False;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckListNormalType', E.Message);
end;
end;
procedure CallProjectPlanFromNB;
begin
try
FSCS_Main.aCreateProjectPlan.Execute;
except
on E: Exception do addExceptionToLogEx('U_ProjectPlan.CallProjectPlanFromNB', E.Message);
end;
end;
procedure CreateCabinetOnCAD(aSCSID, aIndex: Integer);
var
Cabinet: TCabinet;
Bnd: TDoubleRect;
P1: TPoint;
P2: TPoint;
CP: TPoint;
LHandle: Integer;
begin
try
// ñîçäàíèå ñ ÌÏ
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
FSCS_Main.aToolCabinet.Execute;
LHandle := GCadForm.PCad.GetLayerHandle(9);
Bnd := GCadForm.PCad.GetVisibleRect;
P1.X := Round(Bnd.Left);
P1.Y := Round(bnd.Top);
P2.X := Round(Bnd.Right);
P2.Y := Round(bnd.Bottom);
CP.X := Round((P1.x + P2.x) / 2);
CP.Y := Round((P1.y + P2.y) / 2);
Cabinet := TCabinet.Create(CP.X, CP.Y, CP.X + 80, CP.Y + 40,
2, ord(psSolid), clMaroon, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad);
Cabinet.FSCSID := aSCSID;
Cabinet.ID := aSCSID; //08.11.2011
Cabinet.FIndex := aIndex;
Cabinet.Visible := True;
Cabinet.FType := ct_Visual;
Cabinet.FNumberObject := CreateNumberObjectOnCAD(Cabinet, GCadForm.FShowCabinetsNumbers);
GCadForm.Pcad.AddCustomFigure(9, Cabinet, False);
GCadForm.AddSCSFigure(Cabinet);
CP.X := CP.X + 80;
CP.Y := CP.Y + 40;
ClientToScreen(GCadForm.PCad.Handle, CP);
SetCursorPos(CP.X, CP.Y);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CreateCabinetOnCAD', E.Message);
end;
end;
procedure DeleteCabinetOnCAD(AID_List, aSCSID: Integer);
var
Cabinet: TFigure;
vList: TF_CAD;
CabinetNumberObject: TCabinetNumber;
aFigure: TFigure;
j: INteger;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
Cabinet := FindCabinetBySCSID(vList, aSCSID);
if Cabinet <> nil then
begin
if CheckFigureByClassName(Cabinet, cTCabinet) then
CabinetNumberObject := TCabinet(Cabinet).FNumberObject;
if CheckFigureByClassName(Cabinet, cTCabinetExt) then
CabinetNumberObject := TCabinetExt(Cabinet).FNumberObject;
if CabinetNumberObject <> nil then
begin
vList.PCad.Figures.Remove(CabinetNumberObject);
FreeAndNil(CabinetNumberObject);
end;
vList.PCad.Figures.Remove(Cabinet);
FreeAndNil(Cabinet);
RefreshCAD(vList.PCad);
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.DeleteCabinetOnCAD', E.Message);
end;
end;
procedure ActivateCabinetOnCAD(AID_List, aSCSID: Integer);
var
Cabinet: TFigure;
vList: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
if not vList.FShowCabinetsBounds then
begin
Cabinet := FindCabinetBySCSID(vList, aSCSID);
if Cabinet <> nil then
begin
if CheckFigureByClassName(Cabinet, cTCabinet) then
begin
TCabinet(Cabinet).Visible := True;
TCabinet(Cabinet).Draw(vList.PCad.DEngine, False);
end;
if CheckFigureByClassName(Cabinet, cTCabinetExt) then
begin
TCabinetExt(Cabinet).Visible := True;
TCabinetExt(Cabinet).Draw(vList.PCad.DEngine, False);
end;
RefreshCAD(vList.PCad);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ActivateCabinetOnCAD', E.Message);
end;
end;
procedure DeactivateCabinetOnCAD(AID_List, aSCSID: Integer);
var
Cabinet: TFigure;
vList: TF_CAD;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
if not vList.FShowCabinetsBounds then
begin
Cabinet := FindCabinetBySCSID(vList, aSCSID);
if Cabinet <> nil then
begin
if Cabinet.Selected then
Cabinet.Deselect;
if CheckFigureByClassName(Cabinet, cTCabinet) then
begin
TCabinet(Cabinet).Visible := False;
TCabinet(Cabinet).Draw(vList.PCad.DEngine, False);
if TCabinet(Cabinet).FNumberObject <> nil then
if TCabinet(Cabinet).FNumberObject.Visible then
if TCabinet(Cabinet).FNumberObject.Selected then
TCabinet(Cabinet).FNumberObject.Deselect;
end;
if CheckFigureByClassName(Cabinet, cTCabinetExt) then
begin
TCabinetExt(Cabinet).Visible := False;
TCabinetExt(Cabinet).Draw(vList.PCad.DEngine, False);
if TCabinetExt(Cabinet).FNumberObject <> nil then
if TCabinetExt(Cabinet).FNumberObject.Visible then
if TCabinetExt(Cabinet).FNumberObject.Selected then
TCabinetExt(Cabinet).FNumberObject.Deselect;
end;
RefreshCAD(vList.PCad);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.DeactivateCabinetOnCAD', E.Message);
end;
end;
function FindCabinetBySCSID(aList: TF_CAD; aSCSID: Integer): TFigure;
var
i: integer;
Figure: TFigure;
FigLayerHandle: Integer;
begin
Result := nil;
try
FigLayerHandle := aList.PCad.GetLayerHandle(lnRoom);
for i := 0 to aList.PCad.FigureCount - 1 do
begin
Figure := TFigure(aList.PCad.Figures[i]);
if (Figure.LayerHandle = FigLayerHandle) then
begin
if CheckFigureByClassName(Figure, cTCabinet) then
begin
if TCabinet(Figure).FSCSID = aSCSID then
begin
Result := Figure;
Break;
end;
end
else if CheckFigureByClassName(Figure, cTCabinetExt) then
begin
if TCabinetExt(Figure).FSCSID = aSCSID then
begin
Result := Figure;
Break;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.FindCabinetBySCSID', E.Message);
end;
end;
function CreateNumberObjectOnCAD(aCabinet: TFigure; aVisible: Boolean): TCabinetNumber;
var
i: integer;
Number: TRichText;
Bound: TCircle;
Radius: Double;
CabCP: TDoublePoint;
NoteBnd: TDoubleRect;
CaptionGroup: TRichText;
TM: TTextMetric;
xCanvas: TMetafileCanvas;
h, w: double;
TraceCP: TDoublePoint;
MvAngle: Double;
Bnd: TDoubleRect;
MaxX, MaxY, MinX, MinY: Double;
begin
try
Result := nil;
Result := TCabinetNumber.Create(aCabinet.LayerHandle, GCadForm.PCad);
Radius := 5;
Bound := TCircle.Create(-100, -100, Radius, 1, ord(psSolid), clMaroon, ord(bsClear), clBlack,
aCabinet.LayerHandle, mydsNormal, GCadForm.PCad);
{******************************************************************************}
Number := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clMaroon, ord(bsClear), clNone,
aCabinet.LayerHandle, mydsNormal, GCadForm.PCad);
Number.re.Font.Size := 12;
Number.re.Font.Color := clMaroon;
Number.re.Lines.Clear;
if CheckFigureByClassName(aCabinet, cTCabinet) then
Number.re.Lines.Add(IntToStr(TCabinet(aCabinet).FIndex));
if CheckFigureByClassName(aCabinet, cTCabinetExt) then
Number.re.Lines.Add(IntToStr(TCabinetExt(aCabinet).FIndex));
GCadForm.PCad.AddCustomFigure(9, Number, False);
RefreshCAD(GCadForm.PCad);
// ïîëó÷èòü ñâîéñòâà
xCanvas := TMetafileCanvas.Create(Number.Metafile, 0);
xCanvas.Font.Name := Number.re.Font.Name;
xCanvas.Font.Size := Number.re.Font.Size;
GetTextMetrics(xCanvas.Handle, TM);
h := TM.tmHeight / 4 * Number.re.Lines.Count;
w := xCanvas.TextWidth(Number.Re.Lines[0]);
w := (w + 3) / 4 ;
FreeAndNil(xCanvas);
// ïåðåñîçäàòü ñ íîâûìè ñâîéñòâàìè
if Number <> nil then
begin
GCadForm.PCad.Figures.Remove(Number);
FreeAndNil(Number);
end;
Number := TRichText.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clMaroon, ord(bsClear), clNone,
aCabinet.LayerHandle, mydsNormal, GCadForm.PCad);
Number.re.Font.Size := 12;
Number.re.Font.Color := clMaroon;
Number.re.Lines.Clear;
if CheckFigureByClassName(aCabinet, cTCabinet) then
Number.re.Lines.Add(IntToStr(TCabinet(aCabinet).FIndex));
if CheckFigureByClassName(aCabinet, cTCabinetExt) then
Number.re.Lines.Add(IntToStr(TCabinetExt(aCabinet).FIndex));
Number.Move(Bound.CenterPoint.x - Number.CenterPoint.x, Bound.CenterPoint.y - Number.CenterPoint.y);
Result.AddFigure(Bound);
Result.AddFigure(Number);
// íàéòè öåíòð êàáèíåòà
// äëÿ îáû÷íîãî
if CheckFigureByClassName(aCabinet, cTCabinet) then
begin
CabCP.x := (aCabinet.ActualPoints[1].x + aCabinet.ActualPoints[3].x) / 2;
CabCP.y := (aCabinet.ActualPoints[1].y + aCabinet.ActualPoints[3].y) / 2;
end;
// ñëîæíîé ôîðìû
if CheckFigureByClassName(aCabinet, cTCabinetExt) then
begin
TCabinetExt(aCabinet).getbounds(MaxX, MaxY, MinX, MinY);
CabCP.x := (MinX + MaxX) / 2;
CabCP.y := (MinY + MaxY) / 2;
end;
Result.move(CabCP.x - Result.CenterPoint.x, CabCP.y - Result.CenterPoint.y);
GCadForm.PCad.AddCustomFigure(9, Result, False);
//
Result.Visible := aVisible;
for i := 0 to Result.InFigures.Count - 1 do
TFigure(Result.InFigures[i]).Visible := aVisible;
//
Result.LockModify := True;
Result.LockMove := True;
Result.LockSelect := False;
if CheckFigureByClassName(aCabinet, cTCabinet) then
Result.FCabinetID := TCabinet(aCabinet).FSCSID;
if CheckFigureByClassName(aCabinet, cTCabinetExt) then
Result.FCabinetID := TCabinetExt(aCabinet).FSCSID;
except
on E: Exception do addExceptionToLogEx('U_Common.CreateNumberObject', E.Message);
end;
end;
procedure ChangeCabinetParams(AID_List: Integer; AObjectParams: TObjectParams);
var
Cabinet: TFigure;
i: integer;
NumberText: TRichText;
vList: TF_CAD;
SavedCadForm: TF_CAD;
NumberObject: TCabinetNumber;
j:Integer;
aFigure: TFigure;
begin
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
Cabinet := FindCabinetBySCSID(vList, AObjectParams.ID);
if Cabinet <> nil then
begin
SavedCadForm := GCadForm;
GCadForm := vList;
//Ïðîâåðêà ôèãóðû íà âõîæäåíèå â êàáèíåò
if GCadForm.FNeedUpdateCheckedFigures then
GCadForm.UpdateCheckedFigures;
for j := 0 to GCadForm.FCheckedFigures.Count - 1 do
begin
aFigure := TFigure(GCadForm.FCheckedFigures[j]);
GCadForm.Pcad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures, aFigure);
end;
if CheckFigureByClassName(Cabinet, cTCabinet) then
begin
NumberObject := TCabinet(Cabinet).FNumberObject;
if NumberObject <> nil then
begin
RemoveInFigureGrp(NumberObject);
vList.PCad.Figures.Remove(NumberObject);
FreeAndNil(NumberObject);
TCabinet(Cabinet).FIndex := AObjectParams.MarkID;
TCabinet(Cabinet).FFalseFloorHeight := AObjectParams.HeightCeiling;
TCabinet(Cabinet).CabinetConfig := AObjectParams.CabinetConfig;
TCabinet(Cabinet).FNumberObject := CreateNumberObjectOnCAD(Cabinet, vList.FShowCabinetsNumbers);
TCabinet(Cabinet).FNumberObject.Visible := AObjectParams.CabinetConfig.aWorkRoom;
TCabinet(Cabinet).FNumberObject.FPositionIndex := AObjectParams.CabinetConfig.CabinetNumPos;
TCabinet(Cabinet).FNumberObject.IsCabinetExt := AObjectParams.CabinetConfig.IsCabinetExt;
TCabinet(Cabinet).FNumberObject.CircleRadius := AObjectParams.CabinetConfig.NumRadius;
end;
end;
if CheckFigureByClassName(Cabinet, cTCabinetExt) then
begin
NumberObject := TCabinetExt(Cabinet).FNumberObject;
if NumberObject <> nil then
begin
RemoveInFigureGrp(NumberObject);
vList.PCad.Figures.Remove(NumberObject);
FreeAndNil(NumberObject);
TCabinetExt(Cabinet).FIndex := AObjectParams.MarkID;
TCabinetExt(Cabinet).FFalseFloorHeight := AObjectParams.HeightCeiling;
TCabinetExt(Cabinet).CabinetConfig := AObjectParams.CabinetConfig;
TCabinetExt(Cabinet).FNumberObject := CreateNumberObjectOnCAD(Cabinet, vList.FShowCabinetsNumbers);
TCabinetExt(Cabinet).FNumberObject.Visible := AObjectParams.CabinetConfig.aWorkRoom;
TCabinetExt(Cabinet).FNumberObject.FPositionIndex := AObjectParams.CabinetConfig.CabinetNumPos;
TCabinetExt(Cabinet).FNumberObject.IsCabinetExt := AObjectParams.CabinetConfig.IsCabinetExt;
TCabinetExt(Cabinet).FNumberObject.CircleRadius := AObjectParams.CabinetConfig.NumRadius;
end;
end;
MoveObjectsToCabinetOnMove(Cabinet);
GCadForm := SavedCadForm;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ChangeCabinetParams', E.Message);
end;
end;
procedure SetVisibleCabinetsNumbers(aVisible: Boolean);
var
i, j: integer;
Cabinet: TCabinet;
CabinetExt: TCabinetExt;
begin
try
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinet) then
begin
Cabinet := TCabinet(GCadForm.PCad.Figures[i]);
if Cabinet.FNumberObject <> nil then
begin
if not aVisible then
begin
Cabinet.FNumberObject.Visible := aVisible;
for j := 0 to Cabinet.FNumberObject.InFigures.Count - 1 do
TFigure(Cabinet.FNumberObject.InFigures[j]).Visible := aVisible;
end
else
begin
Cabinet.FNumberObject.Visible := Cabinet.CabinetConfig.aWorkRoom;
for j := 0 to Cabinet.FNumberObject.InFigures.Count - 1 do
TFigure(Cabinet.FNumberObject.InFigures[j]).Visible := Cabinet.CabinetConfig.aWorkRoom;
end;
end;
end;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinetExt) then
begin
CabinetExt := TCabinetExt(GCadForm.PCad.Figures[i]);
if CabinetExt.FNumberObject <> nil then
begin
if not aVisible then
begin
CabinetExt.FNumberObject.Visible := aVisible;
for j := 0 to CabinetExt.FNumberObject.InFigures.Count - 1 do
TFigure(CabinetExt.FNumberObject.InFigures[j]).Visible := aVisible;
end
else
begin
CabinetExt.FNumberObject.Visible := CabinetExt.Cabinetconfig.aWorkRoom;
for j := 0 to CabinetExt.FNumberObject.InFigures.Count - 1 do
TFigure(CabinetExt.FNumberObject.InFigures[j]).Visible := CabinetExt.Cabinetconfig.aWorkRoom;
end;
end;
end;
end;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.SetVisibleCabinetsNumbers', E.Message);
end;
end;
procedure SetVisibleCabinetsBounds(aVisible: Boolean);
var
i, j: integer;
Cabinet: TCabinet;
CabinetExt: TCabinetExt;
begin
try
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinet) then
begin
Cabinet := TCabinet(GCadForm.PCad.Figures[i]);
Cabinet.Visible := aVisible;
end;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinetExt) then
begin
CabinetExt := TCabinetExt(GCadForm.PCad.Figures[i]);
CabinetExt.Visible := aVisible;
end;
end;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.SetVisibleCabinetsBounds', E.Message);
end;
end;
function GetCabinetWhereObject(aObject: TFigure): TFigure;
var
i: integer;
X, Y: Double;
Cabinet: TCabinet;
CabinetExt: TCabinetExt;
begin
Result := nil;
try
X := aObject.ActualPoints[1].x;
Y := aObject.ActualPoints[1].y;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinet) then
begin
Cabinet := TCabinet(GCadForm.PCad.Figures[i]);
if Cabinet.FType = ct_Visual then
begin
if Cabinet.CabinetConfig.aWorkRoom then
if Cabinet.isPointInMod(X, Y) then
begin
Result := Cabinet;
Break;
end;
end;
end;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinetExt) then
begin
CabinetExt := TCabinetExt(GCadForm.PCad.Figures[i]);
if CabinetExt.FType = ct_Visual then
begin
if CabinetExt.CabinetConfig.aWorkRoom then
if CabinetExt.isPointInMod(X, Y) then
begin
Result := CabinetExt;
Break;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetCabinetWhereObject', E.Message);
end;
end;
function GetCabinetAtPos(aX, aY: double; aCheckAllFigInside: boolean = True; aMovedFigure: TFigure = nil): TFigure;
var
i, SquareCounter: integer;
Cabinet: TCabinet;
CabinetExt: TCabinetExt;
aFigure:TFigure;
// Tolik
CabinetList : TList;
currSquare: Double;
Catalog: TSCSCatalog;
currList: TSCSList;
square: Double;
SquareList: array of Double;
SortAgain: Boolean;
CatalogList: TSCSCatalogs;
aCad: TF_CAD;
begin
Result := nil;
//ïåðåïèñàíà ñîâñåì (by Tolik), ñòàðûé êîä çàêîììå÷åí ñì. íèæå
CabinetList := TList.Create;
currList := F_ProjMan.GSCSBase.CurrProject.CurrList;
SetLength(SquareList, 0);
SquareCounter := 1;
CatalogList := TSCSCatalogs.Create(False);
aCad := GetListByID(F_ProjMan.GSCSBase.CurrProject.CurrList.SCSID);
try
for i := 0 to currList.ChildCatalogReferences.Count - 1 do
begin
Catalog := currList.ChildCatalogReferences[i];
if Catalog.ItemType = itRoom then
begin
CatalogList.Add(Catalog);
end;
end;
if CatalogList.Count > 0 then
begin
for i := 0 to CatalogList.Count - 1 do
begin
Cabinet := Nil;
CabinetExt := Nil;
Catalog := CatalogList[i];
aFigure := GetFigureByID(aCad, Catalog.SCSID);
if aFigure <> nil then
begin
Cabinet := TCabinet(aFigure);
if not Cabinet.CabinetConfig.IsCabinetExt then
begin
if Cabinet.CabinetConfig.aWorkRoom then
begin
if Cabinet.isPointInMod(aX, aY) then
begin
CabinetList.Add(Cabinet);
end;
end;
end
end;
end;
for i := 0 to CatalogList.Count - 1 do
begin
Catalog := CatalogList[i];
aFigure := GetFigureByID(aCad, Catalog.SCSID);
CabinetExt := TCabinetExt(aFigure);
if CabinetExt <> nil then
begin
if CabinetExt.CabinetConfig.IsCabinetExt then
begin
if CabinetExt.CabinetConfig.aWorkRoom then
begin
if CabinetExt.isPointInMod(aX, aY) then
begin
CabinetList.Add(CabinetExt);
end;
end;
end;
end;
end;
end;
if CabinetList.Count = 0 then
Result := GetVirtualCabinet
else
begin
if CabinetList.Count > 1 then
begin
for i := 0 to CabinetList.Count - 1 do
begin
square := GetRoomSquare(currList.SCSID, TFigure(CabinetList[i]).ID);
SetLength(SquareList, SquareCounter);
SquareList[SquareCounter - 1] := Square;
Inc(SquareCounter);
end;
SortAgain := True;
while sortAgain do
begin
SortAgain := False;
for i := 0 to Length(SquareList) - 2 do
begin
if SquareList[i] > SquareList[i + 1] then
begin
SortAgain := True;
Square := SquareList[i];
SquareList[i] := SquareList[i + 1];
SquareList[i + 1] := Square;
aFigure := TFigure(CabinetList[i]);
CabinetList[i] := CabinetList[i + 1];
CabinetList[i + 1] := aFigure;
end;
end;
end;
end;
Result := TFigure(CabinetList[0]);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetCabinetAtPos', E.Message);
end;
{
try
if GCadForm.FNeedUpdateCheckedFigures then
GCadForm.UpdateCheckedFigures;
if aMovedFigure <> nil then
begin
GCadForm.PCad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures, aMovedFigure);
end
else
begin
if aCheckAllFigInside then
begin
for i := 0 to GCadForm.FCheckedFigures.Count - 1 do
begin
aFigure := TFigure(GCadForm.FCheckedFigures[i]);
GCadForm.PCad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures, aFigure);
end;
end;
end;
//for i := 0 to GCadForm.PCad.FigureCount - 1 do
for i := 0 to GCadForm.FCheckedFigures.Count - 1 do
begin
//if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinet) then
if CheckFigureByClassName(TFigure(GCadForm.FCheckedFigures[i]), cTCabinet) then
begin
//Cabinet := TCabinet(GCadForm.PCad.Figures[i]);
Cabinet := TCabinet(GCadForm.FCheckedFigures[i]);
if Cabinet.FType = ct_Virtual then
begin
Result := Cabinet;
end;
//
if Cabinet.FType = ct_Visual then
// if (Cabinet.FType = ct_Visual) or (Cabinet.FType = ct_Virtual) then
begin
if Cabinet.CabinetConfig.aWorkRoom then
if Cabinet.isPointInMod(aX, aY) then
begin
Result := Cabinet;
Break;
//CabinetList.Add(Cabinet);
end;
end;
end;
//if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinetExt) then
if CheckFigureByClassName(TFigure(GCadForm.FCheckedFigures[i]), cTCabinetExt) then
begin
//CabinetExt := TCabinetExt(GCadForm.PCad.Figures[i]);
CabinetExt := TCabinetExt(GCadForm.FCheckedFigures[i]);
if CabinetExt.FType = ct_Virtual then
begin
Result := CabinetExt;
end;
if CabinetExt.FType = ct_Visual then
begin
if CabinetExt.CabinetConfig.aWorkRoom then
if CabinetExt.isPointInMod(aX, aY) then
begin
Result := CabinetExt;
Break;
//CabinetList.Add(CabinetExt);
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetCabinetAtPos', E.Message);
end; }
SetLength(SquareList, 0);
if CabinetList.Count > 0 then
FreeAndNil(CabinetList);
end;
procedure MoveObjectsToCabinetOnCreate(aCabinet: TFigure);
var
i: Integer;
Line: TOrthoLine;
Conn: TConnectorObject;
begin
try
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then
begin
Line := TOrthoLine(GCadForm.PCad.Figures[i]);
if CheckFigureByClassName(aCabinet, cTCabinet) then
begin
if TCabinet(aCabinet).isPointInMod(Line.ActualPoints[1].x, Line.ActualPoints[1].y) then
begin
if (Line.FCabinetID <> TCabinet(aCabinet).FSCSID) then
begin
Line.FCabinetID := TCabinet(aCabinet).FSCSID;
MoveObjectToRoomInPM(GCadForm.FCADListID, Line.ID, Line.FCabinetID);
end;
end;
end;
if CheckFigureByClassName(aCabinet, cTCabinetExt) then
begin
if TCabinetExt(aCabinet).isPointInMod(Line.ActualPoints[1].x, Line.ActualPoints[1].y) then
begin
if (Line.FCabinetID <> TCabinetExt(aCabinet).FSCSID) then
begin
Line.FCabinetID := TCabinetExt(aCabinet).FSCSID;
MoveObjectToRoomInPM(GCadForm.FCADListID, Line.ID, Line.FCabinetID);
end;
end;
end;
end;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then
begin
Conn := TConnectorObject(GCadForm.PCad.Figures[i]);
if CheckFigureByClassName(aCabinet, cTCabinet) then
begin
if TCabinet(aCabinet).isPointInMod(Conn.ActualPoints[1].x, Conn.ActualPoints[1].y) then
begin
if (Conn.FCabinetID <> TCabinet(aCabinet).FSCSID) then
begin
Conn.FCabinetID := TCabinet(aCabinet).FSCSID;
MoveObjectToRoomInPM(GCadForm.FCADListID, Conn.ID, Conn.FCabinetID);
end;
end;
end;
if CheckFigureByClassName(aCabinet, cTCabinetExt) then
begin
if TCabinetExt(aCabinet).isPointInMod(Conn.ActualPoints[1].x, Conn.ActualPoints[1].y) then
begin
if (Conn.FCabinetID <> TCabinetExt(aCabinet).FSCSID) then
begin
Conn.FCabinetID := TCabinetExt(aCabinet).FSCSID;
MoveObjectToRoomInPM(GCadForm.FCADListID, Conn.ID, Conn.FCabinetID);
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.MoveObjectsToCabinet', E.Message);
end;
end;
procedure MoveObjectsToCabinetOnMove(aCabinet: TFigure);
var
i: Integer;
Line: TOrthoLine;
Conn: TConnectorObject;
OtherCabinet: TFigure;
aFigure: TFigure;
begin
try
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
aFigure := TFigure(GCadForm.PCad.Figures[i]);
GCadForm.PCad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures, aFigure);
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then
begin
// LINE
Line := TOrthoLine(GCadForm.PCad.Figures[i]);
if CheckFigureByClassName(aCabinet, cTCabinet) then
begin
if (TCabinet(aCabinet).isPointInMod(Line.ActualPoints[1].x, Line.ActualPoints[1].y))and(TCabinet(aCabinet).CabinetConfig.aWorkRoom) then
begin
// â îáëàñòè äàííîãî êàáèíåòà
if (Line.FCabinetID <> TCabinet(aCabinet).FSCSID) then
begin
Line.FCabinetID := TCabinet(aCabinet).FSCSID;
MoveObjectToRoomInPM(GCadForm.FCADListID, Line.ID, Line.FCabinetID);
end;
end
else
begin
// âíå îáëàñòè äàííîãî êàáèíåòà
if (Line.FCabinetID = TCabinet(aCabinet).FSCSID) then
begin
// íàéòè â êàêîì êàáèíåòå îí òåïåðü îñòàëñÿ
OtherCabinet := GetCabinetAtPos(Line.ActualPoints[1].x, Line.ActualPoints[1].y, False);
if OtherCabinet <> nil then
begin
if CheckFigureByClassName(OtherCabinet, cTCabinet) then
Line.FCabinetID := TCabinet(OtherCabinet).FSCSID;
if CheckFigureByClassName(OtherCabinet, cTCabinetExt) then
Line.FCabinetID := TCabinetExt(OtherCabinet).FSCSID;
end
else
Line.FCabinetID := -1;
MoveObjectToRoomInPM(GCadForm.FCADListID, Line.ID, Line.FCabinetID);
end;
end;
end;
if CheckFigureByClassName(aCabinet, cTCabinetExt) then
begin
if (TCabinetExt(aCabinet).isPointInMod(Line.ActualPoints[1].x, Line.ActualPoints[1].y))and(TCabinetExt(aCabinet).CabinetConfig.aWorkRoom) then
begin
// â îáëàñòè äàííîãî êàáèíåòà
if (Line.FCabinetID <> TCabinetExt(aCabinet).FSCSID) then
begin
Line.FCabinetID := TCabinetExt(aCabinet).FSCSID;
MoveObjectToRoomInPM(GCadForm.FCADListID, Line.ID, Line.FCabinetID);
end;
end
else
begin
// âíå îáëàñòè äàííîãî êàáèíåòà
if (Line.FCabinetID = TCabinetExt(aCabinet).FSCSID) then
begin
// íàéòè â êàêîì êàáèíåòå îí òåïåðü îñòàëñÿ
OtherCabinet := GetCabinetAtPos(Line.ActualPoints[1].x, Line.ActualPoints[1].y, False);
if OtherCabinet <> nil then
begin
if CheckFigureByClassName(OtherCabinet, cTCabinet) then
Line.FCabinetID := TCabinet(OtherCabinet).FSCSID;
if CheckFigureByClassName(OtherCabinet, cTCabinetExt) then
Line.FCabinetID := TCabinetExt(OtherCabinet).FSCSID;
end
else
Line.FCabinetID := -1;
MoveObjectToRoomInPM(GCadForm.FCADListID, Line.ID, Line.FCabinetID);
end;
end;
end;
end;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then
begin
// CONN
Conn := TConnectorObject(GCadForm.PCad.Figures[i]);
if CheckFigureByClassName(aCabinet, cTCabinet) then
begin
if (TCabinet(aCabinet).isPointInMod(Conn.ActualPoints[1].x, Conn.ActualPoints[1].y))and(TCabinet(aCabinet).CabinetConfig.aWorkRoom) then
begin
// â îáëàñòè äàííîãî êàáèíåòà
if (Conn.FCabinetID <> TCabinet(aCabinet).FSCSID) then
begin
Conn.FCabinetID := TCabinet(aCabinet).FSCSID;
MoveObjectToRoomInPM(GCadForm.FCADListID, Conn.ID, Conn.FCabinetID);
end;
end
else
begin
// âíå îáëàñòè äàííîãî êàáèíåòà
if (Conn.FCabinetID = TCabinet(aCabinet).FSCSID) then
begin
// íàéòè â êàêîì êàáèíåòå îí òåïåðü îñòàëñÿ
OtherCabinet := GetCabinetAtPos(Conn.ActualPoints[1].x, Conn.ActualPoints[1].y, False);
if OtherCabinet <> nil then
begin
if CheckFigureByClassName(OtherCabinet, cTCabinet) then
Conn.FCabinetID := TCabinet(OtherCabinet).FSCSID;
if CheckFigureByClassName(OtherCabinet, cTCabinetExt) then
Conn.FCabinetID := TCabinetExt(OtherCabinet).FSCSID;
end
else
Conn.FCabinetID := -1;
MoveObjectToRoomInPM(GCadForm.FCADListID, Conn.ID, Conn.FCabinetID);
end;
end;
end;
if CheckFigureByClassName(aCabinet, cTCabinetExt) then
begin
if (TCabinetExt(aCabinet).isPointInMod(Conn.ActualPoints[1].x, Conn.ActualPoints[1].y))and(TCabinetExt(aCabinet).CabinetConfig.aWorkRoom) then
begin
// â îáëàñòè äàííîãî êàáèíåòà
if (Conn.FCabinetID <> TCabinetExt(aCabinet).FSCSID) then
begin
Conn.FCabinetID := TCabinetExt(aCabinet).FSCSID;
MoveObjectToRoomInPM(GCadForm.FCADListID, Conn.ID, Conn.FCabinetID);
end;
end
else
begin
// âíå îáëàñòè äàííîãî êàáèíåòà
if (Conn.FCabinetID = TCabinetExt(aCabinet).FSCSID) then
begin
// íàéòè â êàêîì êàáèíåòå îí òåïåðü îñòàëñÿ
OtherCabinet := GetCabinetAtPos(Conn.ActualPoints[1].x, Conn.ActualPoints[1].y, False);
if OtherCabinet <> nil then
begin
if CheckFigureByClassName(OtherCabinet, cTCabinet) then
Conn.FCabinetID := TCabinet(OtherCabinet).FSCSID;
if CheckFigureByClassName(OtherCabinet, cTCabinetExt) then
Conn.FCabinetID := TCabinetExt(OtherCabinet).FSCSID;
end
else
Conn.FCabinetID := -1;
MoveObjectToRoomInPM(GCadForm.FCADListID, Conn.ID, Conn.FCabinetID);
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.MoveObjectsToCabinetOnMove', E.Message);
end;
end;
function GetVirtualCabinet: TFigure;
var
i: integer;
begin
Result := nil;
try
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinet) then
begin
if TCabinet(GCadForm.PCad.Figures[i]).FType = ct_Virtual then
begin
Result := TFigure(GCadForm.PCad.Figures[i]);
Break;
end;
end;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinetExt) then
begin
if TCabinetExt(GCadForm.PCad.Figures[i]).FType = ct_Virtual then
begin
Result := TFigure(GCadForm.PCad.Figures[i]);
Break;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.GetVirtualCabinet', E.Message);
end;
end;
function IsNoteExist(aNoteObject: TFigureGrpNotMod): Boolean;
var
i: integer;
Note: TRichTextMod;
begin
Result := True;
//03.11.2011
//try
// Note := nil;
// for i := 0 to aNoteObject.InFigures.Count - 1 do
// begin
// if CheckFigureByClassName(TFigure(aNoteObject.InFigures[i]), cTRichTextMod) then
// Note := TRichTextMod(aNoteObject.InFigures[i]);
// end;
// if Note <> nil then
// begin
// if Note.re.Lines.Count > 0 then
// Result := True
// else
// Result := False;
// end;
// except
// on E: Exception do addExceptionToLogEx('U_Common.IsNoteExist', E.Message);
// end;
Note := nil;
for i := 0 to aNoteObject.InFigures.Count - 1 do
begin
if CheckFigureByClassName(TFigure(aNoteObject.InFigures[i]), cTRichTextMod) then
begin
Note := TRichTextMod(aNoteObject.InFigures[i]);
if Note <> nil then
begin
if Note.re.Lines.Count > 0 then
begin
Result := True;
Break; //// BREAK ////
end
else
Result := False;
end;
end;
end;
end;
function isRaiseEmptyAndNotNeed(aRaiseLine: TOrthoLine): boolean;
var
JoinObject1, JoinObject2: TConnectorObject;
LinesCount1, LinesCount2, ConnsCount1, ConnsCount2: Integer;
begin
try
result := False;
if aRaiseLine.FIsRaiseUpDown then
begin
if CheckEmptyFigure(aRaiseLine.ID) then
begin
JoinObject1 := TConnectorObject(aRaiseLine.JoinConnector1);
JoinObject2 := TConnectorObject(aRaiseLine.JoinConnector2);
ConnsCount1 := JoinObject1.JoinedConnectorsList.Count;
ConnsCount2 := JoinObject2.JoinedConnectorsList.Count;
LinesCount1 := JoinObject1.JoinedOrtholinesList.Count - 1;
LinesCount2 := JoinObject2.JoinedOrtholinesList.Count - 1;
if ((ConnsCount1 = 0) and (LinesCount1 = 0)) or ((ConnsCount2 = 0) and (LinesCount2 = 0)) or (aRaiseLine.LineLength = 0) then
begin
result := True;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.isRaiseEmptyAndNotNeed', E.Message);
end;
end;
procedure CheckDeleteRaise(aRaiseLine: TOrthoLine);
var
ObjFromRaise: TConnectorObject;
RaiseConn: TConnectorObject;
begin
try
if isRaiseEmptyAndNotNeed(aRaiseLine) then
begin
ObjFromRaise := aRaiseLine.FObjectFromRaisedLine;
if ObjFromRaise <> nil then
begin
RaiseConn := GetRaiseConn(ObjFromRaise);
if (RaiseConn <> nil) and (RaiseConn.FConnRaiseType = crt_OnFloor) then
begin
// ?????
if not RaiseConn.Deleted then
begin
if ObjFromRaise.ConnectorType = ct_Clear then
DestroyRaiseOnConnector(ObjFromRaise)
else
DestroyRaiseOnPointObject(ObjFromRaise);
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckDeleteRaise', E.Message);
end;
end;
procedure CheckDeleteAllRaises(aPCad: TPowerCad);
var
i: integer;
RaiseLine: TOrthoLine;
RaisesList: TList;
begin
try
RaisesList := TList.Create;
for i := 0 to aPCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(aPCad.Figures[i]), cTOrthoLine) then
begin
RaiseLine := TOrthoLine(aPCad.Figures[i]);
if RaiseLine.FIsRaiseUpDown then
RaisesList.Add(RaiseLine);
end;
end;
for i := 0 to RaisesList.Count - 1 do
begin
RaiseLine := TOrthoLine(RaisesList[i]);
if (RaiseLine <> nil) and (not RaiseLine.Deleted) then
begin
CheckDeleteRaise(RaiseLine);
end;
end;
FreeAndNil(RaisesList);
RefreshCAD(aPCad);
except
on E: Exception do addExceptionToLogEx('U_Common.CheckDeleteAllRaises', E.Message);
end;
end;
function CheckCADObjectSelect(AID_List, AID_Object: Integer): Boolean;
var
FList: TF_CAD;
FObject: TFigure;
begin
Result := False;
try
FList := GetListByID(AID_List);
if FList <> nil then
begin
FObject := GetFigureByID(FList, AID_Object);
if FObject <> nil then
begin
if FObject.Selected then
Result := True
else
Result := False;
end;
end;
except
on E: Exception do addExceptionToLogEx('', E.Message);
end;
end;
function GetPointObjectsRelations(AID_List: Integer): TObjectList;
var
i, j, k: Integer;
CurObject: TConnectorObject;
CurTrace: TOrthoLine;
FList: TF_CAD;
PointObjectsList: TList;
UsedObjectsList: TList;
GetTrace: TList;
FirstObject: TConnectorObject;
LastObject: TConnectorObject;
PointFigureRelation: TPointFigureRelation;
begin
Result := TObjectList.Create(True);
try
PointObjectsList := TList.Create;
UsedObjectsList := TList.Create;
FList := GetListByID(AID_List);
FList := GCadForm;
if FList <> nil then
begin
// çàïîëíèòü ñïèñîê ÒÎ
for i := 0 to FList.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(FList.PCad.Figures[i]), cTConnectorObject) then
begin
CurObject := TConnectorObject(FList.PCad.Figures[i]);
if CurObject.ConnectorType <> ct_Clear then
PointObjectsList.Add(CurObject);
end;
end;
end;
// ïåðåáðàòü ñîåäèíåíèÿ íà ÊÀÄå
for i := 0 to PointObjectsList.Count - 1 do
begin
FirstObject := TConnectorObject(PointObjectsList[i]);
for j := i + 1 to PointObjectsList.Count - 1 do
begin
LastObject := TConnectorObject(PointObjectsList[j]);
GetTrace := GetAllTraceInCAD(FirstObject, LastObject);
// ñîåäèíåíèå åñòü
if GetTrace <> nil then
begin
PointFigureRelation := TPointFigureRelation.Create;
PointFigureRelation.FirstPointFigure := FirstObject.ID;
PointFigureRelation.LastPointFigure := LastObject.ID;
// îòäåëèòü òðàññû îò ÒÎ è çàíåñòè â ñïèñîê êëàññà
for k := 0 to GetTrace.Count - 1 do
begin
if CheckFigureByClassName(TFigure(GetTrace[k]), cTOrthoLine) then
begin
CurTrace := TOrthoLine(GetTrace[k]);
PointFigureRelation.Traces.Add(CurTrace.ID);
end;
end;
Result.Add(PointFigureRelation);
end;
end;
end;
FreeAndNil(PointObjectsList);
FreeAndNil(UsedObjectsList);
except
on E: Exception do addExceptionToLogEx('U_Common.GetPointObjectsRelations', E.Message);
end;
end;
Procedure ReScaleAllDimLines;
var
i: integer;
HDimLine: TSCSHDimLine;
VDimLine: TSCSVDimLine;
begin
try
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTSCSHDimLine) then
begin
HDimLine := TSCSHDimLine(GCadForm.PCad.Figures[i]);
HDimLine.FValue := HDimLine.GetValue;
HDimLine.DLabel := FormatFloat(ffMask, HDimLine.FValue);
HDimLine.AutoText := True;
HDimLine.Modified := True;
end;
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTSCSVDimLine) then
begin
VDimLine := TSCSVDimLine(GCadForm.PCad.Figures[i]);
VDimLine.FValue := VDimLine.GetValue;
VDimLine.DLabel := FormatFloat(ffMask, VDimLine.FValue);
VDimLine.AutoText := True;
VDimLine.Modified := True;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ReScaleAllDimLines', E.Message);
end;
end;
Function CheckObjectDeleted(AID_List, AID_Object: Integer): Boolean;
var
FFigure: TFigure;
vList: TF_CAD;
begin
Result := False;
try
vList := GetListByID(AID_List);
if vList <> nil then
begin
FFigure := GetFigureByID(vList, AID_Object);
if FFigure <> nil then
begin
if FFigure.Deleted then
Result := True
else
Result := False;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckObjectDeleted', E.Message);
end;
end;
procedure ReverseCaptionAfterTypeChange(aLine: TOrthoLine; aOldType, aNewType: TShowKind);
var
PairStr: string;
LengthStr: string;
begin
try
// ïåðåêëþ÷àåòñÿ ñ îáû÷íîãî íà âíåøíèå ÑÊÑ
if (aOldType <> skExternalSCS) and (aNewType = skExternalSCS) then
begin
aLine.OutTextCaptions.Clear;
PairStr := GetPairCountFromTrace(GCadForm.FCADListID, aLine.ID);
aLine.OutTextCaptions.Add(PairStr);
LengthStr := GetLineCaptionFormat(aLine, GCadForm.FShowLineCaptionsType);
aLine.OutTextCaptions.Add(LengthStr);
end
else
// ïåðåêëþ÷àåòñÿ ñ âíåøíèõ ÑÊÑ íà îáû÷íå
if (aOldType = skExternalSCS) and (aNewType <> skExternalSCS) then
begin
aLine.OutTextCaptions.Clear;
LengthStr := GetLineCaptionFormat(aLine, GCadForm.FShowLineCaptionsType);
aLine.OutTextCaptions.Add(LengthStr);
end;
except
on E: Exception do addExceptionToLogEx('TOrthoLine.ReverseCaptionAfterTypeChange', E.Message);
end;
end;
procedure SetDimLinesType(aType: TDimLinesType);
var
i: Integer;
FFigure: TFigure;
EndType: TEndType;
begin
try
EndType := etRow; //#From Oleg# //14.09.2010
if aType = dlt_None then
EndType := etClear;
if aType = dlt_Row then
EndType := etRow;
if aType = dlt_Stroke then
EndType := etNick;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
FFigure := TFigure(GCadForm.PCad.Figures[i]);
if CheckFigureByClassName(FFigure, cTSCSHDimLine) then
begin
TSCSHDimLine(FFigure).EndType := EndType;
end;
if CheckFigureByClassName(FFigure, cTSCSVDimLine) then
begin
TSCSVDimLine(FFigure).EndType := EndType;
end;
if CheckFigureByClassName(FFigure, 'THDimLine') then
begin
THDimLine(FFigure).EndType := EndType;
end;
if CheckFigureByClassName(FFigure, 'TVDimLine') then
begin
TVDimLine(FFigure).EndType := EndType;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetDimLinesType', E.Message);
end;
end;
function CheckTrunkObject(aObject: TConnectorObject): Boolean;
begin
Result := false;
try
if aObject = nil then
exit;
if CheckFigureByClassName(aObject, cTConnectorObject) then
begin
if (aObject.FTrunkName = ctsnCrossATS) or (aObject.FTrunkName = ctsnDistributionCabinet) then
Result := True
else
Result := False;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckTrunkObject', E.Message);
end;
end;
function CreateSCSObjectDuplicates(ACad: TF_CAD; aObjects: TList): TList;
var
i, j, k: integer;
vConn, ResConn: TConnectorObject;
vLine, ResLine: TOrthoLine;
ClearsList: TList;
ObjectsList: TList;
ClearConn, OtherClearConn: TConnectorObject;
PointConn, GetParentDup: TConnectorObject;
DrawDeltaX, DrawDeltaY: double;
TotalList: TList;
FFigure: TFigure;
ResConnectingTraces: TList;
vConnectingTraces: TList;
ResConnectingLine: TOrthoLine;
vConnectingLine: TOrthoLine;
isSP: Boolean;
Net: TNet;
begin
Result := TList.create;
try
if not CheckAnyButFigureGrp(aObjects) then
begin
EndProgress;
ShowMessage(cCommon_Mes22);
Exit;
end;
ClearsList := TList.Create;
ObjectsList := TList.Create;
TotalList := TList.Create;
for i := 0 to aObjects.Count - 1 do
begin
FFigure := TFigure(aObjects[i]);
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
vConn := TConnectorObject(FFigure);
if vConn.ConnectorType <> ct_Clear then
begin
// ÊÐÎÑÑ ÀÒÑ
if vConn.FTrunkName = ctsnCrossATS then
begin
ResConn := vConn.CreateCrossATSDuplicate(vConn.ActualPoints[1].x, vConn.ActualPoints[1].y);
ResConn.tmpParentDupID := vConn.ID;
if CheckNoFigureInList(ResConn, ObjectsList) then
ObjectsList.Add(ResConn);
TotalList.Add(ResConn);
vConnectingTraces := GetAllConnectingTraces(vConn);
ResConnectingTraces := GetAllConnectingTraces(ResConn);
for j := 0 to ResConnectingTraces.Count - 1 do
begin
ResConnectingLine := TOrthoLine(ResConnectingTraces[j]);
vConnectingLine := TOrthoLine(vConnectingTraces[j]);
TConnectorObject(ResConnectingLine.JoinConnector1).tmpParentDupID := TConnectorObject(vConnectingLine.JoinConnector1).ID;
TConnectorObject(ResConnectingLine.JoinConnector2).tmpParentDupID := TConnectorObject(vConnectingLine.JoinConnector2).ID;
if CheckNoFigureInList(ResConnectingLine.JoinConnector1, ClearsList) then
begin
ClearsList.Add(ResConnectingLine.JoinConnector1);
TotalList.Add(ResConnectingLine.JoinConnector1);
end;
TotalList.Add(ResConnectingLine);
end;
end
else
// ÐÀÑÏÐÅÄÅËÈÒÅËÜÍÛÉ ØÊÀÔ
if vConn.FTrunkName = ctsnDistributionCabinet then
begin
ResConn := vConn.CreateDistribCabDuplicate(vConn.ActualPoints[1].x, vConn.ActualPoints[1].y);
ResConn.tmpParentDupID := vConn.ID;
if CheckNoFigureInList(ResConn, ObjectsList) then
ObjectsList.Add(ResConn);
TotalList.Add(ResConn);
vConnectingTraces := GetAllConnectingTraces(vConn);
ResConnectingTraces := GetAllConnectingTraces(ResConn);
for j := 0 to ResConnectingTraces.Count - 1 do
begin
ResConnectingLine := TOrthoLine(ResConnectingTraces[j]);
vConnectingLine := TOrthoLine(vConnectingTraces[j]);
TConnectorObject(ResConnectingLine.JoinConnector1).tmpParentDupID := TConnectorObject(vConnectingLine.JoinConnector1).ID;
TConnectorObject(ResConnectingLine.JoinConnector2).tmpParentDupID := TConnectorObject(vConnectingLine.JoinConnector2).ID;
if CheckNoFigureInList(ResConnectingLine.JoinConnector1, ClearsList) then
begin
ClearsList.Add(ResConnectingLine.JoinConnector1);
TotalList.Add(ResConnectingLine.JoinConnector1);
end;
TotalList.Add(ResConnectingLine);
end;
end
else
// ÎÁÛ×ÍÛÉ
begin
ResConn := vConn.CreateDuplicate(vConn.ActualPoints[1].x, vConn.ActualPoints[1].y);
ResConn.tmpParentDupID := vConn.ID;
if CheckNoFigureInList(ResConn, ObjectsList) then
ObjectsList.Add(ResConn);
TotalList.Add(ResConn);
end;
end;
end
else
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
vLine := TOrthoLine(FFigure);
if (not vLine.FConnectingLine) and (not vLine.FIsVertical) then
begin
GLastTracedLinePoints1 := vLine.ActualPoints[1];
GLastTracedLinePoints2 := vLine.ActualPoints[2];
ResLine := vLine.CreateDuplicate;
TConnectorObject(ResLine.JoinConnector1).tmpParentDupID := TConnectorObject(vLine.JoinConnector1).ID;
TConnectorObject(ResLine.JoinConnector2).tmpParentDupID := TConnectorObject(vLine.JoinConnector2).ID;
if CheckNoFigureInList(ResLine.JoinConnector1, ClearsList) then
begin
ClearsList.Add(ResLine.JoinConnector1);
TotalList.Add(ResLine.JoinConnector1);
end;
if CheckNoFigureInList(ResLine.JoinConnector2, ClearsList) then
begin
ClearsList.Add(ResLine.JoinConnector2);
TotalList.Add(ResLine.JoinConnector2);
end;
TotalList.Add(ResLine);
GLastTracedLinePoints1 := DoublePoint(-10000, -10000);
GLastTracedLinePoints2 := DoublePoint(-10000, -10000);
end;
end
else if FFigure is TNet then
begin
Net := TNet(FFigure).CreateDuplicate;
GArchEngine.SetHandlersToObj(Net);
ACad.PCad.AddCustomFigure(lnArch, Net, False);
//CAD.PCad.AddCustomFigure(lnArch, Net, False);
RefreshNet(Net);
TotalList.Add(Net);
end;
end;
// ñîçäàòü âñå ñâÿçè
// 1 - ñâÿçü ïóñòîãî ñ ïóñòûì
for i := 0 to ClearsList.Count - 1 do
begin
ClearConn := TConnectorObject(ClearsList[i]);
if (ClearConn <> nil) and (not ClearConn.Deleted) then
begin
for j := i + 1 to ClearsList.Count - 1 do
begin
OtherClearConn := TConnectorObject(ClearsList[j]);
if (OtherClearConn <> nil) and (not OtherClearConn.Deleted) then
begin
if ClearConn.ID <> OtherClearConn.ID then
if ClearConn.tmpParentDupID = OtherClearConn.tmpParentDupID then
begin
SnapConnectorToConnector(ClearConn, OtherClearConn);
end;
end;
end;
end;
end;
// 2 - ñâÿçü ïóñòîãî ñ ÒÎ
for i := 0 to ObjectsList.Count - 1 do
begin
PointConn := TConnectorObject(ObjectsList[i]);
GetParentDup := TConnectorObject(GetFigureByID(GCadForm, PointConn.tmpParentDupID));
for j := 0 to GetParentDup.JoinedConnectorsList.Count - 1 do
begin
ClearConn := TConnectorObject(GetParentDup.JoinedConnectorsList[j]);
OtherClearConn := GetJoinedConnForDuplicate(ClearsList, ClearConn.ID);
if (OtherClearConn <> nil) and (not OtherClearConn.Deleted) then
begin
SnapConnectorToPointObject(OtherClearConn, PointConn);
end;
end;
end;
// ïî÷èñòèòü ïóñòûå êîííåêòîðû
for i := 0 to ClearsList.Count - 1 do
begin
ClearConn := TConnectorObject(ClearsList[i]);
if CheckFigureByClassName(ClearConn, cTConnectorObject) then
begin
if (ClearConn <> nil) and (not ClearConn.Deleted) then
begin
ClearConn.tmpParentDupID := -1;
if (ClearConn.FConnRaiseType = crt_None) and (ClearConn.LockMove) then
begin
isSP := False;
for j := 0 to ClearConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(ClearConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then
isSP := True;
if (IsSP) and (ClearConn.JoinedConnectorsList.Count = 0) then
begin
ClearConn.LockMove := False;
ClearConn.LockModify := False;
end;
end;
end;
end;
end;
// çàíåñòè â Result
for i := 0 to TotalList.Count - 1 do
begin
FFigure := TFigure(TotalList[i]);
if (FFigure <> nil) and (not FFigure.Deleted) then
if CheckFigureByClassName(FFigure, cTConnectorObject) or
CheckFigureByClassName(FFigure, cTOrthoLine) or
(FFigure is TNet) then
Result.Add(FFigure);
end;
FreeAndNil(TotalList);
FreeAndNil(ClearsList);
FreeAndNil(ObjectsList);
except
on E: Exception do addExceptionToLogEx('U_Common.CreateSCSObjectDuplicates', E.Message);
end;
end;
function GetJoinedConnForDuplicate(aClearConns: TList; aParentDupID: Integer): TConnectorObject;
var
i: Integer;
ClearConn: TConnectorObject;
begin
Result := nil;
try
for i := 0 to aClearConns.Count - 1 do
begin
ClearConn := TConnectorObject(aClearConns[i]);
if (ClearConn <> nil) and (not ClearConn.Deleted) then
begin
if ClearConn.tmpParentDupID = aParentDupID then
Result := ClearConn;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetJoinedConnForDuplicate', E.Message);
end;
end;
Procedure AutoConnectOverDivideLine(AConnDivider, AConnOther: TConnectorObject; ADividedLine, ANewLine: TOrthoLine);
var
i, j: integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
ptrConnectObjParam: PConnectObjectParam;
ConnectedLines: TList;
ConnectedBeforeRaise: TList;
ConnectedAfterRaise: TList;
PointObject: TConnectorObject;
OtherPointObject: TConnectorObject;
AfterConnector: TConnectorObject;
BeforeConnector: TConnectorObject;
DevidedLineSideJoinedToAfterConn: Integer;
procedure DefineConnectedObjectParams(ATargetConnectedObjectParams: TList;
AConnectorObject: TConnectorObject; ASkipLine1, ASkipLine2: TOrtholine; AAddConn: Boolean);
var
i, j: Integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
ptrConnectObjParam: PConnectObjectParam;
begin
if AAddConn then
begin
New(ptrConnectObjParam);
ptrConnectObjParam.IDObject := AConnectorObject.ID;
ptrConnectObjParam.Side := 0;
ATargetConnectedObjectParams.Add(ptrConnectObjParam);
end;
if AConnectorObject.ConnectorType = ct_Clear then
for i := 0 to AConnectorObject.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnectorObject.JoinedOrtholinesList[i]);
if (JoinedLine <> ASkipLine1) and (JoinedLine <> ASkipLine2) then
begin
New(ptrConnectObjParam);
ptrConnectObjParam.IDObject := JoinedLine.ID;
if JoinedLine.JoinConnector1 = AConnectorObject then
ptrConnectObjParam.Side := 1;
if JoinedLine.JoinConnector2 = AConnectorObject then
ptrConnectObjParam.Side := 2;
ATargetConnectedObjectParams.Add(ptrConnectObjParam);
end;
end
else
begin
for i := 0 to AConnectorObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(AConnectorObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
if (JoinedLine <> ASkipLine1) and (JoinedLine <> ASkipLine2) then
begin
New(ptrConnectObjParam);
ptrConnectObjParam.IDObject := JoinedLine.ID;
if JoinedLine.JoinConnector1 = JoinedConn then
ptrConnectObjParam.Side := 1;
if JoinedLine.JoinConnector2 = JoinedConn then
ptrConnectObjParam.Side := 2;
ATargetConnectedObjectParams.Add(ptrConnectObjParam);
end;
end;
end;
end;
end;
function CheckRelatedConns(AConn1, AConn2: TConnectorObject): Boolean;
begin
Result := false;
if AConn1 = AConn2 then
Result := true
else
if (AConn1.ConnectorType = ct_Clear) and (AConn1.JoinedConnectorsList.IndexOf(AConn2) <> -1) then
Result := true
else
if (AConn2.ConnectorType = ct_Clear) and (AConn2.JoinedConnectorsList.IndexOf(AConn1) <> -1) then
Result := true;
end;
begin
try
ConnectedBeforeRaise := TList.Create;
ConnectedAfterRaise := TList.Create;
PointObject := AConnDivider;
OtherPointObject := AConnOther;
//if (AConn1.ConnectorType = ct_Clear) and (AConn2.ConnectorType <> ct_Clear) then
//begin
// PointObject := AConn2;
// OtherPointObject := AConn1;
//end;
//13.11.2008 DefineConnectedObjectParams(ConnectedBeforeRaise, PointObject, ANewLine, nil, false);
//13.11.2008 DefineConnectedObjectParams(ConnectedAfterRaise, OtherPointObject, ANewLine, nil, true);
//13.11.2008
AfterConnector := nil;
BeforeConnector := nil;
DevidedLineSideJoinedToAfterConn := 0;
// ïðîâåðÿåì ïîäêëþ÷åíèå ðàçäåëåííîé ëèíèè ñòîðîíîé 1
if CheckRelatedConns(TConnectorObject(ADividedLine.JoinConnector1), PointObject) then
AfterConnector := PointObject
else
if CheckRelatedConns(TConnectorObject(ADividedLine.JoinConnector1), OtherPointObject) then
AfterConnector := OtherPointObject;
if AfterConnector <> nil then
DevidedLineSideJoinedToAfterConn := 1
else
begin
// ïðîâåðÿåì ïîäêëþ÷åíèå ðàçäåëåííîé ëèíèè ñòîðîíîé 2
if CheckRelatedConns(TConnectorObject(ADividedLine.JoinConnector2), PointObject) then
AfterConnector := PointObject
else
if CheckRelatedConns(TConnectorObject(ADividedLine.JoinConnector2), OtherPointObject) then
AfterConnector := OtherPointObject;
if AfterConnector <> nil then
DevidedLineSideJoinedToAfterConn := 2;
end;
if DevidedLineSideJoinedToAfterConn > 0 then
begin
// äîáàâëÿåì ðàçäåëåííóþ ëèíèþ â ñïèñîê ConnectedAfterRaise
New(ptrConnectObjParam);
ptrConnectObjParam.IDObject := ADividedLine.ID;
ptrConnectObjParam.Side := DevidedLineSideJoinedToAfterConn;
ConnectedAfterRaise.Add(ptrConnectObjParam);
if AfterConnector = PointObject then
BeforeConnector := OtherPointObject
else
BeforeConnector := PointObject;
// Â ñïèñîê ConnectedBeforeRaise äîáàâëÿåì îáúåêòû ñâÿçàííûå ñ BeforeConnector
if BeforeConnector <> nil then
//10.02.2014 DefineConnectedObjectParams(ConnectedBeforeRaise, BeforeConnector, nil, ADividedLine, false);
DefineConnectedObjectParams(ConnectedBeforeRaise, BeforeConnector, ANewLine, ADividedLine, true);
end;
AutoConnectOverRaiseLine(PointObject.ID, ANewLine.ID, ConnectedBeforeRaise, ConnectedAfterRaise, ltTrace);
if ConnectedBeforeRaise <> nil then
FreeList(ConnectedBeforeRaise);
if ConnectedAfterRaise <> nil then
FreeList(ConnectedAfterRaise);
except
on E: Exception do addExceptionToLogEx('U_Common.AutoConnectOverDivideLine', E.Message);
end;
end;
Procedure AutoDisconnectOverDivideLine(AConn1, AConn2: TConnectorObject; ALine: TOrthoLine);
var
JoinedConn: TConnectorObject;
ConnectedLines: TList;
ConnectedBeforeRaise: TList;
ConnectedAfterRaise: TList;
PointObject: TConnectorObject;
OtherPointObject: TConnectorObject;
procedure DefineConnectedObjectParams(ATargetConnectedObjectParams: TList; AConnectorObject: TConnectorObject);
var
i, j: Integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
ptrConnectObjParam: PConnectObjectParam;
begin
New(ptrConnectObjParam);
ptrConnectObjParam.IDObject := AConnectorObject.ID;
ptrConnectObjParam.Side := 0;
ATargetConnectedObjectParams.Add(ptrConnectObjParam);
if AConnectorObject.ConnectorType = ct_Clear then
for i := 0 to AConnectorObject.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnectorObject.JoinedOrtholinesList[i]);
if JoinedLine <> ALine then
begin
New(ptrConnectObjParam);
ptrConnectObjParam.IDObject := JoinedLine.ID;
if JoinedLine.JoinConnector1 = AConnectorObject then
ptrConnectObjParam.Side := 1;
if JoinedLine.JoinConnector2 = AConnectorObject then
ptrConnectObjParam.Side := 2;
ATargetConnectedObjectParams.Add(ptrConnectObjParam);
end;
end
else
begin
for i := 0 to AConnectorObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(AConnectorObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
if JoinedLine <> ALine then
begin
New(ptrConnectObjParam);
ptrConnectObjParam.IDObject := JoinedLine.ID;
if JoinedLine.JoinConnector1 = JoinedConn then
ptrConnectObjParam.Side := 1;
if JoinedLine.JoinConnector2 = JoinedConn then
ptrConnectObjParam.Side := 2;
ATargetConnectedObjectParams.Add(ptrConnectObjParam);
end;
end;
end;
end;
end;
begin
try
ConnectedBeforeRaise := TList.Create;
ConnectedAfterRaise := TList.Create;
PointObject := AConn1;
OtherPointObject := AConn2;
//if (AConn1.ConnectorType = ct_Clear) and (AConn2.ConnectorType <> ct_Clear) then
//begin
// PointObject := AConn2;
// OtherPointObject := AConn1;
//end;
// AConnector
DefineConnectedObjectParams(ConnectedBeforeRaise, PointObject);
// ARaiseConnector
DefineConnectedObjectParams(ConnectedAfterRaise, OtherPointObject);
AutoDisconnectOverRaiseLine(ALine.ID, ConnectedBeforeRaise, ConnectedAfterRaise);
if ConnectedBeforeRaise <> nil then
FreeList(ConnectedBeforeRaise);
if ConnectedAfterRaise <> nil then
FreeList(ConnectedAfterRaise);
except
on E: Exception do addExceptionToLogEx('AutoDisconnectOverDivideLine', E.Message);
end;
end;
function GetFigureObjectByID(aListID, aObjectID: Integer): TFigure;
var
vList: TF_CAD;
vObject: TFigure;
begin
Result := nil;
try
vList := GetListByID(aListID);
if vList <> nil then
begin
vObject := GetFigureByID(vList, aObjectID);
// íàéäåí
if vObject <> nil then
Result := vObject
else
// íå íàéäåí, èñêàòü â SCSFigureGroup
begin
vObject := GetFigureByIDInSCSFigureGroups(vList, aObjectID);
if vObject <> nil then
Result := vObject;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetFigureObjectByID', E.Message);
end;
end;
procedure SetNewObjectsIDs(aObjects: TObjectList; aIDs: TIntList);
var
i, j: Integer;
vFigure: TFigure;
vID: Integer;
Conn: TConnectorObject;
begin
try
if aObjects.Count > 0 then
TF_CAD(TPowerCad(TFigure(aObjects[0]).Owner).Owner).FSCSFigures.Clear;
for i := 0 to aObjects.Count - 1 do
begin
vFigure := TFigure(aObjects[i]);
vID := aIDs[i];
// êîííåêòîð èëè îðòèëèíèÿ
if CheckFigureByClassName(vFigure, cTConnectorObject) or CheckFigureByClassName(vFigure, cTOrthoLine) then
begin
vFigure.ID := vID;
if vFigure.Owner <> nil then
TF_CAD(TPowerCad(vFigure.Owner).Owner).AddSCSFigure(vFigure);
end
else
// êàáèíåò
if CheckFigureByClassName(vFigure, cTCabinet) then
begin
TCabinet(vFigure).FSCSID := vID;
TCabinet(vFigure).FNumberObject.FCabinetID := TCabinet(vFigure).FSCSID;
TCabinet(vFigure).ID := vID; //08.11.2011
if vFigure.Owner <> nil then
TF_CAD(TPowerCad(vFigure.Owner).Owner).AddSCSFigure(vFigure);
end
else
// êàáèíåò
if CheckFigureByClassName(vFigure, cTCabinetExt) then
begin
TCabinetExt(vFigure).FSCSID := vID;
TCabinetExt(vFigure).FNumberObject.FCabinetID := TCabinetExt(vFigure).FSCSID;
TCabinetExt(vFigure).ID := vID; //08.11.2011
if vFigure.Owner <> nil then
TF_CAD(TPowerCad(vFigure.Owner).Owner).AddSCSFigure(vFigure);
end
else
// êàáèíåò
if CheckFigureByClassName(vFigure, cTHouse) then
begin
THouse(vFigure).ID := vID;
end
else
// íå íàéäåí, èñêàòü âíóòðè SCSFigureGroup
begin
end;
end;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then
begin
Conn := TConnectorObject(GCadForm.PCad.Figures[i]);
if Conn.ConnectorType = ct_Clear then
begin
if Conn.JoinedConnectorsList.Count > 0 then
begin
Conn.ID := GenNewSCSID;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetNewObjectsIDs', E.Message);
end;
end;
function CanDeleteObjectFromPM(aListID, aObjectID: Integer): Boolean;
var
i: Integer;
vList: TF_CAD;
vObject: TFigure;
vLine: TOrthoLine;
vConn: TConnectorObject;
begin
Result := True;
try
vList := GetListByID(aListID);
if vList <> nil then
begin
vObject := GetFigureByID(vList, aObjectID);
if vObject <> nil then
begin
if CheckFigureByClassName(vObject, cTConnectorObject) then
begin
vConn := TConnectorObject(vObject);
for i := 0 to vConn.JoinedOrtholinesList.Count - 1 do
if TOrthoLine(vConn.JoinedOrtholinesList[i]).FConnectingLine then
Result := False;
end
else if CheckFigureByClassName(vObject, cTOrthoLine) then
begin
vLine := TOrthoLine(vObject);
if vLine.FConnectingLine then
Result := False;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CanDeleteObjectFromPM', E.Message);
end;
end;
procedure SetAllTracesAutoLength;
var
i: Integer;
Trace: TOrthoLine;
TracesList: TList;
begin
try
TracesList := TList.Create;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then
TracesList.Add(TFigure(GCadForm.PCad.Figures[i]));
end;
for i := 0 to TracesList.Count - 1 do
begin
Trace := TOrthoLine(TracesList[i]);
Trace.UserLength := -1;
Trace.CalculLength := Trace.LengthCalc;
Trace.LineLength := Trace.CalculLength;
SetLineFigureLengthInPM(Trace.ID, Trace.LineLength);
Trace.UpdateLengthTextBox(True, true);
end;
FreeAndNil(TracesList);
except
on E: Exception do addExceptionToLogEx('U_Common.SetAllTracesAutoLength', E.Message);
end;
end;
procedure SetAllTracesUserLength;
var
i: Integer;
Trace: TOrthoLine;
TracesList: TList;
begin
try
TracesList := TList.Create;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then
TracesList.Add(TFigure(GCadForm.PCad.Figures[i]));
end;
for i := 0 to TracesList.Count - 1 do
begin
Trace := TOrthoLine(TracesList[i]);
if Trace.UserLength = -1 then
Trace.UserLength := 0;
Trace.CalculLength := Trace.LengthCalc;
Trace.LineLength := Trace.CalculLength;
SetLineFigureLengthInPM(Trace.ID, Trace.LineLength);
Trace.UpdateLengthTextBox(True, true);
end;
FreeAndNil(TracesList);
except
on E: Exception do addExceptionToLogEx('U_Common.SetAllTracesUserLength', E.Message);
end;
end;
function CheckFigureByClassName(aFigure: TFigure; const aClassName: string): Boolean;
begin
Result := False;
try
if aFigure <> nil then
begin
if aFigure.ClassName = aClassName then
Result := True;
end;
except
on E: Exception do
Result := False;
end;
//GProcCnt := GProcCnt + 1;
end;
function CheckFigureByClassIdx(aFigure: TFigure; const aClassIdx: Integer): Boolean;
begin
Result := False;
try
if aFigure <> nil then
begin
if aFigure.FClassIndex = aClassIdx then
Result := True;
end;
except
on E: Exception do
Result := False;
end;
end;
procedure SetExistOtherObjectType(aListID, aObjectID: Integer; aExist: Boolean);
var
FList: TF_CAD;
FLine: TOrthoLine;
begin
try
FList := GetListByID(aListID);
if FList <> nil then
begin
FLine := TOrthoLine(GetFigureByID(FList, aObjectID));
if FLine <> nil then
begin
Fline.FExistOtherObjectType := aExist;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetExistOtherObjectType', E.Message);
end;
end;
function GetTrunkNumber(aLine: TOrthoLine): string;
var
i, j: Integer;
StartConn, CurConn, JoinConn: TConnectorObject;
CadCrossObject: TCADCrossObject;
CadCrossObjectElement: TCADCrossObjectElement;
CrossesList: TList;
DistribsList: TList;
CurCross, FindedCross: TConnectorObject;
FindedPos: Integer;
FindedTrace: TList;
begin
try
Result := '';
FindedCross := nil;
FindedPos := -1;
StartConn := TConnectorObject(aLine.JoinConnector1);
// Íàéòè âñå Êðîññ ÀÒÑ
CrossesList := TList.Create;
DistribsList := TList.Create;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
If CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then
begin
CurConn := TConnectorObject(GCadForm.PCad.Figures[i]);
if CurConn.FTrunkName = ctsnCrossATS then
CrossesList.Add(CurConn);
if CurConn.FTrunkName = ctsnDistributionCabinet then
DistribsList.Add(CurConn);
end;
end;
// ïåðåáðàòü ñïèñîê êðîññîâ
for i := 0 to CrossesList.Count - 1 do
begin
CurCross := TConnectorObject(CrossesList[i]);
FindedTrace := GetAllTraceInCAD(CurCross, StartConn);
// íàøëè íóæíûé êðîññ
if FindedTrace <> nil then
begin
FindedCross := CurCross;
Break;
end;
end;
// íàéòè íîìåð ìàãèñòðàëè îò íàéäåííîãî êðîññà
if FindedCross <> nil then
begin
// íå òðàññèðîâàòü ÷åðåç êðîññû
for i := 0 to CrossesList.Count - 1 do
TConnectorObject(CrossesList[i]).FDisableTracing := True;
for i := 0 to DistribsList.Count - 1 do
TConnectorObject(DistribsList[i]).FDisableTracing := True;
for i := 0 to FindedCross.JoinedConnectorsList.Count - 1 do
begin
JoinConn := TConnectorObject(FindedCross.JoinedConnectorsList[i]);
FindedTrace := GetAllTraceInCAD(JoinConn, StartConn);
if FindedTrace <> nil then
begin
FindedPos := i;
Break;
end;
end;
// óáðàòü ôëàã
for i := 0 to CrossesList.Count - 1 do
TConnectorObject(CrossesList[i]).FDisableTracing := False;
for i := 0 to DistribsList.Count - 1 do
TConnectorObject(DistribsList[i]).FDisableTracing := False;
// îáðàáîòàòü ñàìó ïîçèöèþ
if FindedPos <> -1 then
begin
CadCrossObject := GetPointObjectConnectedTrunk(GCadForm.FCADListID, FindedCross.ID);
if CadCrossObject <> nil then
begin
CadCrossObjectElement := TCADCrossObjectElement(CadCrossObject.Elements[FindedPos]);
if CadCrossObjectElement <> nil then
Result := CadCrossObjectElement.Npp;
end;
end;
end;
FreeAndNil(CrossesList);
FreeAndNil(DistribsList);
except
on E: Exception do addExceptionToLogEx('U_Common.GetTrunkNumber', E.Message);
end;
end;
function SCSGroupSelection: TSCSFigureGrp;
var
i: integer;
FFigure: TFigure;
grp: TSCSFigureGrp;
sel: TList;
SelMod: TList;
cnt: integer;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
ObjFromRaise: TConnectorObject;
Conn1, Conn2: TConnectorObject;
begin
Result := nil;
try
sel := TList.Create;
SelMod := TList.Create;
GCadForm.PCad.collectselectedFigures(sel);
cnt := sel.count;
sel.Clear;
if cnt = 0 then
exit;
grp := TSCSFigureGrp.create(LongInt(GCadForm.PCad.Layers[2]), GCadForm.PCad);
for i := GCadForm.PCad.figures.count - 1 downto 0 do
begin
FFigure := Tfigure(GCadForm.PCad.figures[i]);
if FFigure.Selected then
begin
FFigure.Deselect;
if CheckNoFigureInList(FFigure, sel) then
begin
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
if not TConnectorObject(FFigure).FIsApproach then
sel.Add(FFigure);
end;
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
sel.Add(FFigure);
end;
end;
end;
end;
// Correct for External
if GCadForm.FSCSType = st_External then
begin
for i := 0 to sel.Count - 1 do
begin
FFigure := TFigure(sel[i]);
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
Conn1 := TConnectorObject(TOrthoLine(FFigure).JoinConnector1);
Conn2 := TConnectorObject(TOrthoLine(FFigure).JoinConnector2);
if CheckNoFigureInList(Conn1, sel) then
sel.Add(Conn1);
if CheckNoFigureInList(Conn2, sel) then
sel.Add(Conn2);
end;
end;
end;
for i := sel.count - 1 downto 0 do
begin
FFigure := TFigure(sel[i]);
if CheckNoFigureInList(FFigure, SelMod) then
SelMod.Add(FFigure);
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
if TConnectorObject(FFigure).ConnectorType = ct_Clear then
begin
RaiseConn := nil;
RaiseLine := nil;
if TConnectorObject(FFigure).JoinedConnectorsList.Count > 0 then
ObjFromRaise := TConnectorObject(TConnectorObject(FFigure).JoinedConnectorsList[0])
else
ObjFromRaise := TConnectorObject(FFigure);
RaiseConn := GetRaiseConn(ObjFromRaise);
if RaiseConn <> nil then
RaiseLine := GetRaiseLine(RaiseConn);
if RaiseConn <> nil then
if CheckNoFigureInList(RaiseConn, SelMod) then
begin
SelMod.Add(RaiseConn);
end;
if RaiseLine <> nil then
if CheckNoFigureInList(RaiseLine, SelMod) then
begin
SelMod.Add(RaiseLine);
end;
end;
end;
end;
for i := SelMod.count - 1 downto 0 do
begin
FFigure := TFigure(SelMod[i]);
GCadForm.PCad.Figures.Remove(FFigure);
grp.AddFigure(FFigure);
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
TConnectorObject(FFigure).FGroupObject := grp;
end;
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
TOrthoLine(FFigure).FGroupObject := grp;
end;
end;
FreeAndNil(sel);
FreeAndNil(SelMod);
grp.select;
GCadForm.PCad.AddCustomFigure(2, grp, False);
grp.CreateMetaFile;
RefreshCAD(GCadForm.PCad);
Result := grp;
except
on E: Exception do addExceptionToLogEx('U_Common.SCSGroupSelections', E.Message);
end;
end;
function SCSGroupObjects(aObjects: TList): TSCSFigureGrp;
var
i: integer;
FFigure: TFigure;
grp: TSCSFigureGrp;
begin
Result := nil;
try
grp := TSCSFigureGrp.create(LongInt(GCadForm.PCad.Layers[2]), GCadForm.PCad);
for i := aObjects.count - 1 downto 0 do
begin
FFigure := TFigure(aObjects[i]);
if (FFigure <> nil) and (not FFigure.Deleted) then
begin
GCadForm.PCad.Figures.Remove(FFigure);
grp.AddFigure(FFigure);
if CheckFigureByClassName(FFigure, cTConnectorObject) then
if (not TConnectorObject(FFigure).FIsApproach) and (not TConnectorObject(FFigure).FIsHouseJoined) then
begin
TConnectorObject(FFigure).FGroupObject := grp;
end;
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
TOrthoLine(FFigure).FGroupObject := grp;
end;
end;
end;
GCadForm.PCad.AddCustomFigure(2, grp, False);
grp.CreateMetaFile;
RefreshCAD(GCadForm.PCad);
Result := grp;
except
on E: Exception do addExceptionToLogEx('U_Common.SCSGroupObjects', E.Message);
end;
end;
Procedure SCSUngroupSelection;
var
i: Integer;
FFigure: TFigure;
begin
try
for i := GCadForm.PCad.Figures.count - 1 downto 0 do
begin
FFigure := TFigure(GCadForm.PCad.Figures[i]);
if CheckFigureByClassName(FFigure, cTSCSFigureGrp) and (FFigure.selected) then
begin
if not TFigureGrp(FFigure).AlwaysTogether then
begin
TSCSFigureGrp(FFigure).UnGroup;
GCadForm.PCad.Figures.Delete(i);
end;
end;
end;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.SCSGroupSelections', E.Message);
end;
end;
function IsLockedObject(aListID, aObjectID: Integer): Boolean;
var
vList: TF_CAD;
vObject: TFigure;
begin
Result := False;
try
vList := GetListByID(aListID);
if vList <> nil then
begin
vObject := GetFigureByID(vList, aObjectID);
if vObject = nil then
begin
vObject := GetFigureByIDInSCSFigureGroups(vList, aObjectID);
if vObject <> nil then
Result := True;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.IsLockedObject', E.Message);
end;
end;
procedure DisconnectConn(AConn: TConnectorObject);
var
NextConnector: TConnectorObject;
JoinedLine1, JoinedLine2: TOrthoLine;
i: integer;
JoinedConn: TConnectorObject;
CP_Line: TDoublePoint;
OtherConn: TConnectorObject;
OtherConnPoints: TDoublePoint;
begin
BeginProgress;
try
JoinedLine1 := TOrthoLine(AConn.JoinedOrtholinesList[0]);
JoinedLine2 := TOrthoLine(AConn.JoinedOrtholinesList[1]);
if JoinedLine2.JoinConnector1 = AConn then
begin
NextConnector := TConnectorObject(JoinedLine2.JoinConnector2);
if NextConnector.JoinedConnectorsList.Count > 0 then
OtherConn := TConnectorObject(NextConnector.JoinedConnectorsList[0])
else
OtherConn := NextConnector;
OtherConnPoints := OtherConn.ActualPoints[1];
AutoDisconnectOverDivideLine(AConn, OtherConn, JoinedLine2);
TOrthoLine(JoinedLine2).Delete;
RefreshCAD(GCadForm.PCad);
AConn.Move(OtherConnPoints.x - AConn.ActualPoints[1].x, OtherConnPoints.y - AConn.ActualPoints[1].y);
if OtherConn.ConnectorType = ct_Clear then
begin
if (OtherConn <> nil) and (not OtherConn.Deleted) then
SnapConnectorToConnector(AConn, OtherConn);
end
else
begin
SnapConnectorToPointObject(AConn, OtherConn);
end;
end
else
if JoinedLine2.JoinConnector2 = AConn then
begin
NextConnector := TConnectorObject(JoinedLine2.JoinConnector1);
if NextConnector.JoinedConnectorsList.Count > 0 then
OtherConn := TConnectorObject(NextConnector.JoinedConnectorsList[0])
else
OtherConn := NextConnector;
OtherConnPoints := OtherConn.ActualPoints[1];
AutoDisconnectOverDivideLine(AConn, OtherConn, JoinedLine2);
TOrthoLine(JoinedLine2).Delete;
RefreshCAD(GCadForm.PCad);
AConn.Move(OtherConnPoints.x - AConn.ActualPoints[1].x, OtherConnPoints.y - AConn.ActualPoints[1].y);
if OtherConn.ConnectorType = ct_Clear then
begin
if (OtherConn <> nil) and (not OtherConn.Deleted) then
SnapConnectorToConnector(AConn, OtherConn);
end
else
begin
SnapConnectorToPointObject(AConn, OtherConn);
end;
end;
if JoinedLine1 <> nil then
JoinedLine1.ReCreateDrawFigureBlock;
except
on E: Exception do addExceptionToLogEx('U_Common.DisconnectConn', E.Message);
end;
EndProgress;
end;
procedure DisconnectTraces(aConn: TConnectorObject);
var
i, j: Integer;
x, y, z: double;
JoinedLine: TOrthoLine;
CreatedConn: TConnectorObject;
isDisconnected: Boolean;
ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam;
ParamsList1, ParamsList2: TList;
begin
BeginProgress;
try
x := aConn.ActualPoints[1].x;
y := aConn.ActualPoints[1].y;
z := aConn.ActualZOrder[1];
if aConn.JoinedOrtholinesList.Count > 1 then
begin
ParamsList1 := TList.create;
ParamsList2 := TList.create;
for i := 0 to aConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(aConn.JoinedOrtholinesList[i]);
CreatedConn := TConnectorObject.Create(x, y, z, aConn.LayerHandle, mydsNormal, GCadForm.PCad);
CreatedConn.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure(2, CreatedConn, False);
if JoinedLine.JoinConnector1 = aConn then
JoinedLine.SetJConnector1(CreatedConn);
if JoinedLine.JoinConnector2 = aConn then
JoinedLine.SetJConnector2(CreatedConn);
// ParamsList1
if i = 0 then
begin
New(ptrInterfRecord1);
ptrInterfRecord1.IDObject := JoinedLine.ID;
if aConn = JoinedLine.JoinConnector1 then
ptrInterfRecord1.Side := 1;
if aConn = JoinedLine.JoinConnector2 then
ptrInterfRecord1.Side := 2;
ParamsList1.Add(ptrInterfRecord1);
end
else
// ParamsList2
begin
New(ptrInterfRecord2);
ptrInterfRecord2.IDObject := JoinedLine.ID;
if aConn = JoinedLine.JoinConnector1 then
ptrInterfRecord2.Side := 1;
if aConn = JoinedLine.JoinConnector2 then
ptrInterfRecord2.Side := 2;
ParamsList2.Add(ptrInterfRecord2);
end;
end;
//
isDisconnected := DisconnectObjectsInPM(ParamsList1, ParamsList2);
aConn.Delete(False, False);
RefreshCAD(GCadForm.PCad);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.DisconnectTraces', E.Message);
end;
EndProgress;
end;
procedure DisconnectPointObject(aObject: TConnectorObject);
var
i: integer;
PointObject: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
ConnectedConn: TConnectorObject;
PrevConnector: TConnectorObject;
ConnectedList: TList;
begin
BeginProgress;
try
ConnectedConn := nil; //#From Oleg# //14.09.2010
// ýòî ñ-ï
if aObject.FObjectFromRaise <> nil then
begin
RaiseConn := aObject.FObjectFromRaise;
RaiseLine := GetRaiseLine(aObject);
RaiseLine.Delete;
RefreshCAD(GCadForm.PCad);
end;
// íà îáúåêòå åñòü ñ-ï
if GetRaiseConn(aObject) <> nil then
begin
RaiseConn := GetRaiseConn(aObject);
RaiseLine := GetRaiseLine(RaiseConn);
RaiseLine.Delete;
RefreshCAD(GCadForm.PCad);
end;
ConnectedList := TList.Create;
for i := 0 to aObject.JoinedConnectorsList.Count - 1 do
ConnectedList.Add(aObject.JoinedConnectorsList[i]);
if ConnectedList.Count > 0 then
begin
// ðàññîåäèíèòü ñ òðàññàìè íà îäíîì óðîâíå
for i := 0 to ConnectedList.Count - 1 do
begin
ConnectedConn := TConnectorObject(ConnectedList[i]);
UnsnapConnectorFromPointObject(ConnectedConn, aObject);
end;
PrevConnector := TConnectorObject(ConnectedList[0]);
for i := 1 to ConnectedList.Count - 1 do
begin
ConnectedConn := TConnectorObject(ConnectedList[i]);
SnapConnectorToConnector(ConnectedConn, PrevConnector);
PrevConnector := ConnectedConn;
end;
ConnectedConn.Move(aObject.ActualPoints[1].x - ConnectedConn.ActualPoints[1].x,
aObject.ActualPoints[1].y - ConnectedConn.ActualPoints[1].y);
end;
if ConnectedList <> nil then
FreeAndNil(ConnectedList);
aObject.Move(GCadForm.PCad.GridStep, GCadForm.PCad.GridStep);
except
on E: Exception do addExceptionToLogEx('U_Common.DisconnectPointObject', E.Message);
end;
EndProgress;
end;
procedure DeleteAllTraces;
var
i: Integer;
Trace: TOrthoLine;
TracesList: TList;
begin
try
TracesList := TList.Create;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then
begin
Trace := TOrthoLine(GCadForm.PCad.Figures[i]);
TracesList.Add(Trace);
end;
end;
for i := 0 to TracesList.Count - 1 do
begin
Trace := TOrthoLine(TracesList[i]);
Trace.Delete;
end;
RefreshCAD(GCadForm.PCad);
FreeAndNil(TracesList);
except
on E: Exception do addExceptionToLogEx('DeleteAllTraces', E.Message);
end;
end;
procedure DeleteSCSFigureGrps(aListID: Integer);
var
i: Integer;
vList: TF_CAD;
SavedCadForm: TF_CAD;
SCSFigureGrp: TSCSFigureGrp;
GrpList: TList;
begin
try
vList := GetListByID(aListID);
if vList <> nil then
begin
SavedCadForm := GCadForm;
GCadForm := vList;
GrpList := TList.Create;
for i := 0 to vList.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(vList.PCad.Figures[i]), cTSCSFigureGrp) then
begin
SCSFigureGrp := TSCSFigureGrp(vList.PCad.Figures[i]);
GrpList.Add(SCSFigureGrp);
end;
end;
for i := 0 to GrpList.Count - 1 do
begin
SCSFigureGrp := TSCSFigureGrp(GrpList[i]);
SCSFigureGrp.Delete;
end;
FreeAndNil(GrpList);
GCadForm := SavedCadForm;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.DeleteSCSFigureGrps', E.Message);
end;
end;
function CheckAnyButFigureGrp(aFiguresList: TList): Boolean;
var
i: Integer;
Figure: TFigure;
begin
Result := False;
try
for i := 0 to aFiguresList.Count - 1 do
begin
Figure := TFigure(aFiguresList[i]);
if not CheckFigureByClassName(Figure, cTSCSFigureGrp) then
Result := True;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckAnyButFigureGrp', E.Message);
end;
end;
procedure ChangeDrawFigurePercentForObject(aObject: TConnectorObject; aPercent: Double);
var
MapScale: Double;
CorrectX: Double;
CorrectY: Double;
Bnd: TDoubleRect;
begin
try
MapScale := GCadForm.PCad.MapScale;
// âåðíóòü íà 0 ãðàäóñ
aObject.Rotate(0 - aObject.FDrawFigureAngle, aObject.ActualPoints[1]);
if aObject.DrawFigure <> nil then
aObject.DrawFigure.Rotate(0 - aObject.FDrawFigureAngle, aObject.ActualPoints[1]);
// èçìåíèòü ðàçìåðû
// BND
Bnd := aObject.DrawFigure.GetBoundRect;
aObject.GrpSizeX := abs(Bnd.Right - Bnd.Left);
aObject.GrpSizeY := abs(Bnd.Bottom - Bnd.Top);
CorrectX := aObject.FOriginalSizeX / aObject.GrpSizeX;
CorrectY := aObject.FOriginalSizeY / aObject.GrpSizeY;
// correct
aObject.Scale(CorrectX, CorrectY, aObject.ActualPoints[1]);
aObject.DrawFigure.Scale(CorrectX, CorrectY, aObject.ActualPoints[1]);
// percent
aObject.Scale(aPercent / 100, aPercent / 100, aObject.ActualPoints[1]);
aObject.DrawFigure.Scale(aPercent / 100, aPercent / 100, aObject.ActualPoints[1]);
aObject.FDrawFigurePercent := aPercent;
// BND
Bnd := aObject.DrawFigure.GetBoundRect;
aObject.GrpSizeX := abs(Bnd.Right - Bnd.Left);
aObject.GrpSizeY := abs(Bnd.Bottom - Bnd.Top);
// ïîâåðíóòü íàçàä
aObject.Rotate(aObject.FDrawFigureAngle, aObject.ActualPoints[1]);
if aObject.DrawFigure <> nil then
aObject.DrawFigure.Rotate(aObject.FDrawFigureAngle, aObject.ActualPoints[1]);
aObject.DefRaizeDrawFigurePos;
// Recreate
aObject.ReCreateCaptionsGroup(True, false);
aObject.ReCreateNotesGroup(True);
except
on E: Exception do addExceptionToLogEx('U_Common.ChangeDrawFigurePercentForObject', E.Message);
end;
end;
procedure ChangeDrawFigurePercentForLine(aLine: TOrthoLine; aPercent: Double);
var
i: Integer;
MapScale: Double;
CorrectX: Double;
CorrectY: Double;
Bnd: TDoubleRect;
CP: TDoublePoint;
GrpSizeX, GrpSizeY: Double;
tmpDrawFigure: TFigureGrpMod;
BlockBnd: TDoubleRect;
DrawFigureBnd: TDoubleRect;
BlockDelta: double;
deltax, deltay: double;
InFigGroup, InFigGroup1, InFigGroup2: TFigureGrpMod;
delta: double;
ScaleKoeff: Double;
begin
try
if aLine.FIsRaiseUpDown then
begin
if aLine.FSingleBlock <> nil then
begin
{for i := 0 to aLine.DrawFigure.InFigures.Count - 1 do
begin
InFigGroup := TFigureGrpMod(aLine.FSingleBlock.InFigures[i]);
//InFigGroup.Scale(CorrectX, CorrectY, InFigGroup.CenterPoint);
InFigGroup.Scale(aPercent / 100, aPercent / 100, InFigGroup.CenterPoint);
end; }
CP.x := (aLine.ActualPoints[1].x + aLine.ActualPoints[2].x) / 2;
CP.y := (aLine.ActualPoints[1].y + aLine.ActualPoints[2].y) / 2;
InFigGroup := TFigureGrpMod(aLine.FSingleBlock.Duplicate);
//InFigGroup.scale(1, 1, InFigGroup.CenterPoint);
//InFigGroup.scale(0.5*1, 0.5*1, InFigGroup.CenterPoint);
//InFigGroup.scale(1/aLine.FDrawFigurePercent, 1/aLine.FDrawFigurePercent, InFigGroup.CenterPoint);
ScaleKoeff := 1/(aLine.FDrawFigurePercent/100 * 0.5);
InFigGroup.scale(ScaleKoeff, ScaleKoeff, InFigGroup.CenterPoint);
InFigGroup.Rotate(0 - aLine.FDrawFigureAngle, CP);
//InFigGroup.scale(aPercent / 100, aPercent / 100, InFigGroup.CenterPoint);
aLine.FDrawFigurePercent := aPercent;
SetBlockForLineObject(aLine, nil, nil);
aLine.DrawFigure := InFigGroup; //27.04.2013 - ÷òîáû âûçâàòü TOrthoLine.SetDrawFigure
end;
end
else
begin
MapScale := GCadForm.PCad.MapScale;
// âåðíóòü íà 0 ãðàäóñ
CP.x := (aLine.ActualPoints[1].x + aLine.ActualPoints[2].x) / 2;
CP.y := (aLine.ActualPoints[1].y + aLine.ActualPoints[2].y) / 2;
if aLine.DrawFigure <> nil then
aLine.DrawFigure.Rotate(0 - aLine.FDrawFigureAngle, CP);
// Åñëè åñòü áëîê
if aLine.FSingleBlock <> nil then
begin
aLine.DrawFigure.RemoveFromGrp(aLine.FSingleBlock); //28.04.2011 aLine.DrawFigure.InFigures.Remove(aLine.FSingleBlock);
RemoveInFigureGrp(aLine.DrawFigure);
// èçìåíèòü ðàçìåðû
// BND
if aLine.FSingleBlock.InFigures.Count = 0 then
begin
Bnd := aLine.FSingleBlock.GetBoundRect;
end
else
begin
Bnd := TFigure(aLine.FSingleBlock.InFigures[0]).GetBoundRect;
end;
GrpSizeX := abs(Bnd.Right - Bnd.Left);
GrpSizeY := abs(Bnd.Bottom - Bnd.Top);
CorrectX := aLine.FOriginalSizeX / GrpSizeX;
CorrectY := aLine.FOriginalSizeY / GrpSizeY;
for i := 0 to aLine.FSingleBlock.InFigures.Count - 1 do
begin
InFigGroup := TFigureGrpMod(aLine.FSingleBlock.InFigures[i]);
InFigGroup.Scale(CorrectX, CorrectY, InFigGroup.CenterPoint);
InFigGroup.Scale(aPercent / 100, aPercent / 100, InFigGroup.CenterPoint);
end;
if aLine.FSingleBlock.InFigures.Count = 2 then
begin
InFigGroup1 := TFigureGrpMod(aLine.FSingleBlock.InFigures[0]);
InFigGroup2 := TFigureGrpMod(aLine.FSingleBlock.InFigures[1]);
Bnd := InFigGroup1.GetBoundRect;
delta := abs(Bnd.Bottom - Bnd.Top);
delta := delta / 2;
if not aLine.FIsRotated then
InFigGroup2.move(0, InFigGroup1.CenterPoint.y - InFigGroup2.CenterPoint.y + delta)
else
InFigGroup2.move(0, InFigGroup1.CenterPoint.y - InFigGroup2.CenterPoint.y - delta);
aLine.FSingleBlockDelta := 0;
end;
aLine.FDrawFigurePercent := aPercent;
// ïðèñâîèòü òåìïîâîìó DrawFigure
tmpDrawFigure := aLine.GetAllBlocks(aLine.FSingleBlock);
// ïåðåáðîñèòü â DrawFigure
for i := 0 to tmpDrawFigure.InFigures.Count - 1 do
begin
aLine.DrawFigure.AddFigure(TFigure(tmpDrawFigure.InFigures[i]));
end;
if aLine.FSingleBlock.InFigures.Count = 0 then
begin
BlockBnd := aLine.FSingleBlock.GetBoundRect;
end
else
begin
BlockBnd := TFigure(aLine.FSingleBlock.InFigures[0]).GetBoundRect;
end;
DrawFigureBnd := aLine.DrawFigure.GetBoundRect;
aLine.GrpSizeX := DrawFigureBnd.Right - DrawFigureBnd.Left;
aLine.GrpSizeY := BlockBnd.Bottom - BlockBnd.Top;
BlockDelta := 0.2 / 2 * (aLine.FSingleBlock.InFigures.Count - 1);
aLine.DrawFigure.ActualPoints[1] := DoublePoint((DrawFigureBnd.Left + DrawFigureBnd.Right) / 2 - aLine.GrpSizeX / 2,
(BlockBnd.Top + BlockBnd.Bottom) / 2 - aLine.GrpSizeY / 2);
deltax := cp.x - aLine.GrpSizeX / 2 - aLine.DrawFigure.ActualPoints[1].x;
deltay := cp.y - aLine.GrpSizeY / 2 - aLine.DrawFigure.ActualPoints[1].y;
aLine.DrawFigure.move(deltax, deltay);
aLine.DrawFigure.LockModify := True;
aLine.MoveTextBox(aLine.DrawFigure, aLine.ActualPoints[1], aLine.ActualPoints[2], True);
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ChangeDrawFigurePercentForLine', E.Message);
end;
end;
function GetTraceLength(aListID, aTraceID: Integer): Double;
var
FList: TF_CAD;
i: Integer;
Trace: TOrthoLine;
begin
Result := -1;
try
FList := GetListByID(aListID);
if FList <> nil then
begin
Trace := TOrthoLine(GetFigureByID(FList, aTraceID));
if Trace <> nil then
Result := Trace.LineLength;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetTraceLength', E.Message);
end;
end;
procedure CloseCad(aListID: Integer);
var
FList: TF_CAD;
begin
try
FList := GetListByID(aListID);
if FList <> nil then
TF_CAD(FList).Close;
except
on E: Exception do addExceptionToLogEx('U_Common.CloseCad', E.Message);
end;
end;
procedure SetProjectChanged(aChanged: Boolean);
begin
try
GProjectChanged := aChanged;
FSCS_Main.aSaveProject.Enabled := aChanged;
except
on E: Exception do addExceptionToLogEx('U_Common.SetProjectChanged', E.Message);
end;
end;
function GetFigureIconParams(aListID, aObjectID: Integer): TFigureIconParams;
var
FList: TF_CAD;
FFigure: TFigure;
begin
try
FList := GetListByID(aListID);
if FList <> nil then
begin
FFigure := GetFigureByID(FList, aObjectID);
if FFigure <> nil then
begin
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
Result.GUIDObjectIcon := TOrthoLine(FFigure).FBlockGUID;
Result.IconType := TOrthoLine(FFigure).FObjectType;
Result.IconCount := 1;
end;
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
Result.GUIDObjectIcon := TConnectorObject(FFigure).FBlockGUID;
Result.IconType := TConnectorObject(FFigure).FObjectType;
Result.IconCount := TConnectorObject(FFigure).FBlockCount;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetFigureIconParams', E.Message);
end;
end;
function GetSortedListForAutoTrace(aFiguresList: TList): TList;
var
i, j: Integer;
ObjectsList: TList;
BaseObject: TConnectorObject;
BaseObjectFIndex: Integer;
CurObject: TConnectorObject;
CurObjectFIndex: Integer;
MinIndex: Integer;
CurMinFindex: Integer;
begin
Result := TList.Create;
try
ObjectsList := TList.Create;
for i := 0 to aFiguresList.Count - 1 do
if CheckFigureByClassName(TFigure(aFiguresList[i]), cTConnectorObject) then
if TConnectorObject(aFiguresList[i]).ConnectorType <> ct_Clear then
if not TConnectorObject(aFiguresList[i]).AsEndPoint then
ObjectsList.Add(TConnectorObject(aFiguresList[i]));
i := 0;
while i < ObjectsList.Count do
begin
BaseObject := TConnectorObject(ObjectsList[0]);
BaseObjectFIndex := BaseObject.FIndex;
CurMinFindex := BaseObjectFIndex;
MinIndex := 0;
for j := 1 to ObjectsList.Count - 1 do
begin
CurObject := TConnectorObject(ObjectsList[j]);
CurObjectFIndex := CurObject.FIndex;
if CurObjectFIndex < CurMinFindex then
begin
CurMinFindex := CurObjectFIndex;
MinIndex := j;
end;
end;
Result.Add(ObjectsList[MinIndex]);
ObjectsList.Delete(MinIndex);
end;
FreeAndNil(ObjectsList);
except
on E: Exception do addExceptionToLogEx('U_Common.GetSortedListForAutoTrace', E.Message);
end;
end;
function GetObjectBlockbyID(aListID, aObjectID: Integer; aCanLoadIcons: Boolean): TObjectIconParams;
var
i: Integer;
FList: TF_CAD;
FFigure: TFigure;
FObject: TConnectorObject;
FTrace: TOrthoLine;
Stream: TMemoryStream;
Bitmap: TBitmap;
MetaFile: TMetafile;
FileName: string;
DrawFigure: TFigureGrp;
tmpDrawFigure: TFigureGrp;
tmpInFigure: TFigure;
tmpCad: TPowerCad;
begin
try
Result.Executed := False;
Result.GUIDIcon := '';
Result.IconBLK := nil;
Result.IconBMP := nil;
Result.IDIcon := -1;
FList := GetListByID(aListID);
if FList <> nil then
begin
FFigure := GetFigureByID(FList, aObjectID);
DrawFigure := nil;
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
FObject := TConnectorObject(FFigure);
DrawFigure := FObject.DrawFigure;
Result.IDIcon := FObject.FBlockID;
Result.GUIDIcon := FObject.FBlockGUID;
Result.Executed := False;
end
else
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
FTrace := TOrthoLine(FFigure);
DrawFigure := FTrace.FSingleBlock;
Result.IDIcon := FTrace.FBlockID;
Result.GUIDIcon := FTrace.FBlockGUID;
Result.Executed := False;
end;
if DrawFigure <> nil then
begin
if aCanLoadIcons then
begin
TmpCad := TPowerCad.create(FSCS_Main);
TmpCad.Parent := FSCS_Main;
TmpCad.Top := -1000;
TmpCad.Left := -1000;
TmpCad.width := 100;
TmpCad.height := 100;
tmpDrawFigure := TFigureGrp.create(tmpCad.GetLayerHandle(0), tmpCad);
for i := 0 to DrawFigure.InFigures.Count - 1 do
begin
tmpInFigure := TFigure(DrawFigure.InFigures[i]).Duplicate;
tmpDrawFigure.AddFigure(tmpInFigure);
end;
tmpCad.AddCustomFigure(0, tmpDrawFigure, false);
tmpCad.DeselectAll(0);
tmpDrawFigure.Select;
RefreshCAD(tmpCad);
// ïîëó÷èòü Stream ÓÃÎ
Stream := TMemoryStream.Create;
{$if Defined(ES_GRAPH_SC)}
FileName := ExeDir + '\.blk\TempStream.blk';
{$else}
FileName := ExtractFileDir(Application.ExeName) + '\.blk\TempStream.blk';
{$ifend}
tmpCad.MakeSelectionBlock(FileName);
Stream.LoadFromFile(FileName);
Result.IconBLK := Stream;
// ïîëó÷èòü Bitmap ÓÃÎ
MetaFile := TMetafile.Create;
Bitmap := TBitmap.Create;
MetaFile := tmpCad.SelectionAsWmf;
Bitmap.Height := Metafile.Height;
Bitmap.Width := Metafile.Width;
Bitmap.Canvas.Draw(0, 0, MetaFile);
FreeAndNil(MetaFile);
Result.IconBMP := Bitmap;
RemoveInFigureGrp(tmpDrawFigure);
tmpCad.Figures.Remove(tmpDrawFigure);
FreeAndNil(tmpCad);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetObjectBlockbyID', E.Message);
end;
end;
function GetObjectBlockStream(aListID, aObjectID: Integer): TMemoryStream;
var
i: Integer;
FList: TF_CAD;
FFigure: TFigure;
FObject: TConnectorObject;
FTrace: TOrthoLine;
Stream: TMemoryStream;
Bitmap: TBitmap;
MetaFile: TMetafile;
FileName: string;
tmpDrawFigure: TFigureGrp;
tmpInFigure: TFigure;
tmpCad: TPowerCad;
GetDrawFigure: TFigureGrp;
begin
Result := nil;
try
Result := TMemoryStream.Create;
FList := GetListByID(aListID);
if FList <> nil then
begin
FFigure := GetFigureByID(FList, aObjectID);
if FFigure <> nil then
begin
GetDrawFigure := nil;
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
FObject := TConnectorObject(FFigure);
GetDrawFigure := FObject.DrawFigure;
end;
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
FTrace := TOrthoLine(FFigure);
GetDrawFigure := FTrace.FSingleBlock;
end;
if GetDrawFigure <> nil then
begin
TmpCad := TPowerCad.create(FSCS_Main);
TmpCad.Parent := FSCS_Main;
TmpCad.Top := -1000;
TmpCad.Left := -1000;
TmpCad.width := 100;
TmpCad.height := 100;
tmpDrawFigure := TFigureGrp.create(tmpCad.GetLayerHandle(0), tmpCad);
for i := 0 to GetDrawFigure.InFigures.Count - 1 do
begin
tmpInFigure := TFigure(GetDrawFigure.InFigures[i]).Duplicate;
tmpDrawFigure.AddFigure(tmpInFigure);
end;
tmpCad.AddCustomFigure(0, tmpDrawFigure, false);
tmpCad.DeselectAll(0);
tmpDrawFigure.Select;
RefreshCAD(tmpCad);
// ïîëó÷èòü Stream ÓÃÎ
{$if Defined(ES_GRAPH_SC)}
FileName := ExeDir + '\.blk\TempStream.blk';
{$else}
FileName := ExtractFileDir(Application.ExeName) + '\.blk\TempStream.blk';
{$ifend}
tmpCad.MakeSelectionBlock(FileName);
Result.LoadFromFile(FileName);
RemoveInFigureGrp(tmpDrawFigure);
tmpCad.Figures.Remove(tmpDrawFigure);
FreeAndNil(tmpCad);
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.GetObjectBlockStream', E.Message);
end;
end;
function GetObjectBlockToSubstrateLayer(aListID, aObjectID: Integer): Boolean;
var
i: Integer;
FList: TF_CAD;
FFigure: TFigure;
FObject: TConnectorObject;
FTrace: TOrthoLine;
Stream: TMemoryStream;
Bitmap: TBitmap;
MetaFile: TMetafile;
FileName: string;
tmpDrawFigure: TFigureGrp;
tmpInFigure: TFigure;
tmpCad: TPowerCad;
GetDrawFigure: TFigureGrp;
begin
Result := false;
try
FList := GetListByID(aListID);
if FList <> nil then
begin
FFigure := GetFigureByID(FList, aObjectID);
if FFigure <> nil then
begin
GetDrawFigure := nil;
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
FObject := TConnectorObject(FFigure);
GetDrawFigure := FObject.DrawFigure;
end;
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
FTrace := TOrthoLine(FFigure);
GetDrawFigure := FTrace.FSingleBlock;
end;
if GetDrawFigure <> nil then
begin
tmpDrawFigure := TFigureGrp.create(GCadForm.PCad.GetLayerHandle(1), GCadForm.PCad);
for i := 0 to GetDrawFigure.InFigures.Count - 1 do
begin
tmpInFigure := TFigure(GetDrawFigure.InFigures[i]).Duplicate;
tmpDrawFigure.AddFigure(tmpInFigure);
end;
GCadForm.PCad.AddCustomFigure(1, tmpDrawFigure, false);
GCadForm.PCad.DeselectAll(1);
tmpDrawFigure.Select;
RefreshCAD(GCadForm.PCad);
Result := true;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.GetObjectBlockToSubstrateLayer', E.Message);
end;
end;
function ChoiceAutoTraceConnectOrder(AProjectSetting: PProjectSettingRecord=nil; AIsTracing: Boolean=true;
ATraceCompon: TSCSComponent=nil; aFromDropConnObj: Boolean=false; aTracingFigInfo: Pointer=nil): Boolean;
var
ProjectSetting: PProjectSettingRecord;
CurrProjectParams: TProjectParams;
IsLookingCurrProjectParams: Boolean;
begin
Result := false;
try
IsLookingCurrProjectParams := false;
ProjectSetting := AProjectSetting;
//*** Åñëè ïàðàìåòð íå èçâåñòíûé, òî áåðåì íàñòðîéêè òåêóùåãî ïðîåêòà
if ProjectSetting = nil then
begin
CurrProjectParams := GetCurrProjectParams;
IsLookingCurrProjectParams := true;
ProjectSetting := @CurrProjectParams.Setting;
end;
if Not AIsTracing or Not ProjectSetting.TraceNoAskParams then
begin
if GIsProgress then
PauseProgress(true);
try
if (Not GUseVisibleInterfaces) and (AProjectSetting = nil) then
Result := true
else
if F_AutoTraceConnectOrder.Execute(ProjectSetting, ATraceCompon, aTracingFigInfo) then
begin
Result := true;
if IsLookingCurrProjectParams then
SaveCurrProjectParams(CurrProjectParams);
end;
finally
if GIsProgress then
PauseProgress(false);
end;
end
else
Result := true;
except
on E: Exception do addExceptionToLogEx('U_Common.ChoiceAutoTraceConnectOrder', E.Message);
end;
end;
procedure SkipAllLinesShadows(aForm: TF_CAD);
var
i, j: Integer;
vFigure: TFigure;
vLine: TOrthoLine;
begin
try
for i := 0 to aForm.PCad.FigureCount - 1 do
begin
vFigure := TFigure(aForm.PCad.Figures[i]);
if CheckFigureByClassName(vFigure, cTOrthoLine) then
begin
vLine := TOrthoLine(vFigure);
if not vLine.FIsRaiseUpDown then
begin
if vLine.tmpDrawShadow then
begin
vLine.tmpDrawShadow := False;
// vLine.Draw(aForm.PCad.DEngine, False);
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SkipAllLinesShadows', E.Message);
end;
end;
procedure PrintCADLists(aAllLists, aCheckedLists: TIntList);
var
i: Integer;
ListID: Integer;
ListName: string;
FList: TF_CAD;
FCADAllLists: TList;
FCADCheckedLists: TList;
Item: TListItem;
begin
try
FCADAllLists := TList.Create;
FCADCheckedLists := TList.Create;
for i := 0 to aAllLists.Count - 1 do
begin
ListID := aAllLists[i];
FList := GetListByID(ListID);
if FList <> nil then
FCADAllLists.Add(FList);
end;
for i := 0 to aCheckedLists.Count - 1 do
begin
ListID := aCheckedLists[i];
FList := GetListByID(ListID);
if FList <> nil then
FCADCheckedLists.Add(FList);
end;
if FCADAllLists.Count > 0 then
begin
F_PrintLists.lvCadLists.Items.Clear;
for i := 0 to FCADAllLists.Count - 1 do
begin
FList := TF_CAD(FCADAllLists[i]);
Item := F_PrintLists.lvCadLists.Items.Add;
Item.Caption := FList.FCADListName + ' ' + IntToStr(FList.FCADListIndex);
Item.Data := FList.PCad;
if FCADCheckedLists.IndexOf(FList) <> - 1 then
Item.Checked := True
else
Item.Checked := False;
if i = 0 then
begin
F_PrintLists.lvCadLists.Selected := Item;
F_PrintLists.CadControl := FList.PCad;
end;
end;
F_PrintLists.Init;
F_PrintLists.ShowModal;
FreeAndNil(FCADAllLists);
FreeAndNil(FCADCheckedLists);
end;
except
on E: Exception do addExceptionToLogEx('U_Common.PrintCADLists', E.Message);
end;
end;
procedure AutoPosTracesBetweenRM(aConns, aTraces, aSnaps: TList);
var
i: Integer;
Trace: TOrthoLine;
JoinedConn1, JoinedConn2: TConnectorObject;
RM1, RM2: TConnectorObject;
Snap1, Snap2: TFigure;
begin
try
for i := 0 to aTraces.Count - 1 do
begin
Trace := TOrthoLine(aTraces[i]);
JoinedConn1 := TConnectorObject(Trace.JoinConnector1);
JoinedConn2 := TConnectorObject(Trace.JoinConnector2);
Snap1 := TFigure(aSnaps[i]);
Snap2 := TFigure(aSnaps[i + 1]);
if (Snap1 <> nil) and (Snap2 <> nil) then
begin
if CheckFigureByClassName(Snap1, cTConnectorObject) and CheckFigureByClassName(Snap2, cTConnectorObject) then
begin
if (TConnectorObject(Snap1).ConnectorType <> ct_Clear) and (TConnectorObject(Snap2).ConnectorType <> ct_Clear) then
begin
Trace.ActualZOrder[1] := TConnectorObject(Snap1).ActualZOrder[1];
JoinedConn1.ActualZOrder[1] := TConnectorObject(Snap1).ActualZOrder[1];
Trace.ActualZOrder[2] := TConnectorObject(Snap2).ActualZOrder[1];
JoinedConn2.ActualZOrder[1] := TConnectorObject(Snap2).ActualZOrder[1];
// ïîñòàâèòü âûñîòó äëÿ ëèíèè
SetLineFigureCoordZInPM(Trace.ID, 1, Trace.ActualZOrder[1]);
SetLineFigureCoordZInPM(Trace.ID, 2, Trace.ActualZOrder[2]);
SetLineFigureLengthInPM(Trace.ID, Trace.LineLength);
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.AutoPosTracesbetweenRM', E.Message);
end;
end;
procedure AutoPosTracesBetweenRMAfterSnap(aTraces: TList);
var
i: Integer;
Trace: TOrthoLine;
JoinedConn1, JoinedConn2: TConnectorObject;
RM1, RM2: TConnectorObject;
Snap1, Snap2: TFigure;
begin
try
for i := 0 to aTraces.Count - 1 do
begin
Trace := TOrthoLine(aTraces[i]);
JoinedConn1 := TConnectorObject(Trace.JoinConnector1);
JoinedConn2 := TConnectorObject(Trace.JoinConnector2);
if (JoinedConn1.JoinedConnectorsList.Count = 0) or (JoinedConn2.JoinedConnectorsList.Count = 0) then
begin
if (Trace.ActualZOrder[1] <> Trace.ActualZOrder[2]) then
if (Trace.ActualZOrder[1] = GCadForm.FLineHeight) or (Trace.ActualZOrder[2] = GCadForm.FLineHeight) then
begin
RaiseLineOnHeight(Trace, GCadForm.FLineHeight, aTraces);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.AutoPosTracesBetweenRMAfterSnap', E.Message);
end;
end;
procedure SetCabinetFalseFloor(aCabinet: TFigure);
var
Val: Double;
oldtempstr, tempstr: string;
Params: TObjectParams;
begin
try
if CheckFigureByClassName(aCabinet, cTCabinet) then
oldtempstr := FormatFloat(ffMask, MetreToUOM(TCabinet(aCabinet).FFalseFloorHeight));
if CheckFigureByClassName(aCabinet, cTCabinetExt) then
oldtempstr := FormatFloat(ffMask, MetreToUOM(TCabinetExt(aCabinet).FFalseFloorHeight));
tempstr := oldtempstr;
if InputQuery(cCommon_Mes23, cCommon_Mes24, tempstr) then
begin
try
Val := StrToFloat_My(tempstr);
if Val < 0 then
tempstr := '0';
if Val > MetreToUOM(GCadForm.FRoomHeight) then
begin
Val := MetreToUOM(GCadForm.FRoomHeight);
tempstr := FormatFloat(ffMask, Val);
end;
except
ShowMessage(cSizePos_Mes1);
SetCabinetFalseFloor(aCabinet);
Exit;
end;
if (tempstr <> '') and (tempstr <> oldtempstr) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
if CheckFigureByClassName(aCabinet, cTCabinet) then
begin
TCabinet(aCabinet).FFalseFloorHeight := UOMToMetre(StrToFloat_My(Tempstr));
Params := GetFigureParams(TCabinet(aCabinet).FSCSID);
Params.HeightCeiling := TCabinet(aCabinet).FFalseFloorHeight;
SaveFigureParams(TCabinet(aCabinet).FSCSID, Params);
end;
if CheckFigureByClassName(aCabinet, cTCabinetExt) then
begin
TCabinetExt(aCabinet).FFalseFloorHeight := UOMToMetre(StrToFloat_My(Tempstr));
Params := GetFigureParams(TCabinetExt(aCabinet).FSCSID);
Params.HeightCeiling := TCabinetExt(aCabinet).FFalseFloorHeight;
SaveFigureParams(TCabinetExt(aCabinet).FSCSID, Params);
end;
RefreshCAD(GCadForm.PCad);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
SetProjectChanged(True);
end;
except
on E: Exception do addExceptionToLogEx('SetCabinetFalseFloor', E.Message);
end;
end;
procedure CheckAllCabinetsFalseFloorHeights;
var
i: integer;
Cabinet: TCabinet;
CabinetExt: TCabinetExt;
begin
try
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinet) then
begin
Cabinet := TCabinet(GCadForm.PCad.Figures[i]);
if Cabinet.FType = ct_Visual then
begin
if Cabinet.FFalseFloorHeight > GCadForm.FRoomHeight then
Cabinet.FFalseFloorHeight := GCadForm.FRoomHeight;
end;
end
else if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinetExt) then
begin
CabinetExt := TCabinetExt(GCadForm.PCad.Figures[i]);
if CabinetExt.FType = ct_Visual then
begin
if CabinetExt.FFalseFloorHeight > GCadForm.FRoomHeight then
CabinetExt.FFalseFloorHeight := GCadForm.FRoomHeight;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckAllCabinetsFalseFloorHeights', E.Message);
end;
end;
procedure SetCadListFormat(aListFormat: TListFormatType);
var
i: integer;
x1, x2, y1, y2: double;
Cabinet: TFigure;
StampTypeStr, StampLangStr, FullPathName, MainStampName, SideStampName: string;
begin
try
GCadForm.PCad.PageLayout := aListFormat.PageLayout;
GCadForm.PCad.PageOrient := aListFormat.PageOrient;
// if (GCadForm.FListCountX <> 1) or (GCadForm.FListCountY <> 1) then
begin
GCadForm.PCad.WorkWidth := aListFormat.PageWidth;
GCadForm.PCad.WorkHeight := aListFormat.PageHeight;
// âèðòóàëüíûé êàáèíåò
Cabinet := GetVirtualCabinet;
if Cabinet <> nil then
begin
x1 := GCadForm.PCad.Left;
x2 := GCadForm.PCad.Left + GCadForm.PCad.WorkWidth;
y1 := GCadForm.PCad.Top;
y2 := GCadForm.PCad.Top + GCadForm.PCad.WorkHeight;
Cabinet.ActualPoints[1] := DoublePoint(x1, y1);
Cabinet.ActualPoints[2] := DoublePoint(x2, y1);
Cabinet.ActualPoints[3] := DoublePoint(x2, y2);
Cabinet.ActualPoints[4] := DoublePoint(x1, y2);
end;
end;
// îïðåäåëèòü ïàðàìåòðû â èìåíàõ áëîêîâ
{$if Defined(ES_GRAPH_SC)}
FullPathName := ExeDir + '\Stamp\';
{$else}
FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\';
{$ifend}
StampTypeStr := '';
if GCadForm.FCadStampType = stt_simple then
StampTypeStr := 'Small'
else if GCadForm.FCadStampType = stt_extended then
StampTypeStr := 'Big'
else if GCadForm.FCadStampType = stt_detailed then
StampTypeStr := 'ExtBig';
StampLangStr := '';
if GCadForm.FCadStampLang = stl_eng then
StampLangStr := 'eng'
else if GCadForm.FCadStampLang = stl_ukr then
StampLangStr := 'ukr'
else if GCadForm.FCadStampLang = stl_ukr_dstu then
StampLangStr := 'ukr_dstu'
else if GCadForm.FCadStampLang = stl_rus then
StampLangStr := 'rus';
//
MainStampName := StampTypeStr + '_Main_' + StampLangStr + '.sch';
SideStampName := StampTypeStr + '_Side_' + StampLangStr + '.sch';
LoadFrameToList(GCadForm, FullPathName + MainStampName, FullPathName + SideStampName, aListFormat);
except
on E: Exception do addExceptionToLogEx('U_Common.SetCadListFormat', E.Message);
end;
end;
procedure SetCabinetFalseFloorHeightFromPM(aListID, aCabinetID: Integer; aSettings: TRoomSettingRecord);
var
vList: TF_CAD;
vCabinet: TFigure;
begin
try
vList := GetListByID(aListID);
if vList <> nil then
begin
vCabinet := FindCabinetBySCSID(vList, aCabinetID);
if vCabinet <> nil then
begin
if CheckFigureByClassName(vCabinet, cTCabinet) then
TCabinet(vCabinet).FFalseFloorHeight := aSettings.HeightCeiling
else if CheckFigureByClassName(vCabinet, cTCabinetExt) then
TCabinetExt(vCabinet).FFalseFloorHeight := aSettings.HeightCeiling;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetCabinetFalseFloorHeightFromPM', E.Message);
end;
end;
function CheckListFormatChanged(aCad: TF_CAD; aListFormat: TListFormatType): Boolean;
begin
Result := False;
try
// if aCad.PCad.PageLayout <> aListFormat.PageLayout then
// Result := True;
// if aCad.PCad.PageOrient <> aListFormat.PageOrient then
// Result := True;
if aCad.FCadStampLang <> aListFormat.StampLang then
Result := True
else if aCad.FCadStampType <> aListFormat.StampType then
Result := True
else if aCad.FListCountX <> aListFormat.ListCountX then
Result := True
else if aCad.FListCountY <> aListFormat.ListCountY then
Result := True
else if aCad.FShowMainStamp <> aListFormat.ShowMainStamp then
Result := True
else if aCad.FShowUpperStamp <> aListFormat.ShowUpperStamp then
Result := True
else if aCad.FShowSideStamp <> aListFormat.ShowSideStamp then
Result := True
else if aCad.PCad.WorkWidth <> aListFormat.PageWidth then
Result := True
else if aCad.PCad.WorkHeight <> aListFormat.PageHeight then
Result := True
//14.11.2011
else if aCad.FStampFields.Margins.Left <> aListFormat.StampFields.Margins.Left then
Result := True
else if aCad.FStampFields.Margins.Right <> aListFormat.StampFields.Margins.Right then
Result := True
else if aCad.FStampFields.Margins.Top <> aListFormat.StampFields.Margins.Top then
Result := True
else if aCad.FStampFields.Margins.Bottom <> aListFormat.StampFields.Margins.Bottom then
Result := True
else if aCad.FStampFields.Developer <> aListFormat.StampFields.Developer then
Result := True
else if aCad.FStampFields.Checker <> aListFormat.StampFields.Checker then
Result := True
//03.10.2012
else if aCad.FStampFields.ListSign <> aListFormat.StampFields.ListSign then
Result := True
else if aCad.FStampFields.MainEngineer <> aListFormat.StampFields.MainEngineer then
Result := True
else if aCad.FStampFields.Approved <> aListFormat.StampFields.Approved then
Result := True
else if aCad.FStampFields.DesignStage <> aListFormat.StampFields.DesignStage then
Result := True;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckListFormatChanged', E.Message);
end;
end;
procedure CorrectStampView;
var
StampHandle: Integer;
i, j: integer;
Stamp: TFigureGrp;
FFigure: TFigure;
InFigure: TFigure;
FrameFigure: TFigure;
FrameFigureCode: Integer;
MainStampObj, SideStampObj: TFigureGrp;
UpperStampObj: TRectangle;
RectangleObj: TRectangle;
begin
try
StampHandle := GCadForm.PCad.GetLayerHandle(7);
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
FFigure := TFigure(GCadForm.PCad.Figures[i]);
if FFigure.LayerHandle = StampHandle then
begin
if CheckFigureByClassName(FFigure, 'TFigureGrp') then
begin
Stamp := TFigureGrp(FFigure);
MainStampObj := nil;
SideStampObj := nil;
UpperStampObj := nil;
RectangleObj := nil;
for j := 0 to Stamp.InFigures.Count - 1 do
begin
if TFigure(Stamp.InFigures[j]).DataID = 100 then
MainStampObj := TFigureGrp(Stamp.InFigures[j]);
if TFigure(Stamp.InFigures[j]).DataID = 200 then
SideStampObj := TFigureGrp(Stamp.InFigures[j]);
if TFigure(Stamp.InFigures[j]).DataID = 300 then
UpperStampObj := TRectangle(Stamp.InFigures[j]);
if TFigure(Stamp.InFigures[j]).DataID = 99 then
RectangleObj := TRectangle(Stamp.InFigures[j]);
end;
// îñíîâíîé øòàìï
if MainStampObj <> nil then
begin
SetAllInFiguresVisible(MainStampObj, GCadForm.FShowMainStamp);
{//17.11.2011
if GCadForm.FFrameProjectName <> nil then
GCadForm.FFrameProjectName.Visible := GCadForm.FShowMainStamp;
if GCadForm.FFrameListName <> nil then
GCadForm.FFrameListName.Visible := GCadForm.FShowMainStamp;
if GCadForm.FFrameIndexName <> nil then
GCadForm.FFrameIndexName.Visible := GCadForm.FShowMainStamp;}
for j := 0 to GCadForm.FFrameObjects.Count - 1 do
begin
FrameFigure := TFigure(GCadForm.FFrameObjects.Objects[j]);
FrameFigureCode := StrToint(GCadForm.FFrameObjects[j]);
if (FrameFigure <> nil) and (FrameFigureCode <> ftCodeName) then
FrameFigure.Visible := GCadForm.FShowMainStamp;
end;
end;
// áîêîâîé øòàìï
if SideStampObj <> nil then
begin
SetAllInFiguresVisible(SideStampObj, GCadForm.FShowSideStamp);
end;
// âåðõíèé øòàìï
if UpperStampObj <> nil then
begin
UpperStampObj.Visible := GCadForm.FShowUpperStamp;
if GCadForm.FFrameCodeName <> nil then
GCadForm.FFrameCodeName.Visible := GCadForm.FShowUpperStamp;
end;
{$if Defined(SCS_PE) or Defined(SCS_PANDUIT)}
if RectangleObj <> nil then
begin
RectangleObj.Visible := GCadForm.FShowUpperStamp or GCadForm.FShowSideStamp or GCadForm.FShowMainStamp;
end;
{$ifend}
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.CorrectStampView', E.Message);
end;
end;
function IfTraceHorizontal(aTrace: TOrthoLine): Boolean;
begin
Result := False;
try
if DoubleCMP(aTrace.ActualPoints[1].y, aTrace.ActualPoints[2].y) then
Result := True;
except
on E: Exception do addExceptionToLogEx('U_Common.IfTraceHorizontal', E.Message);
end;
end;
function IfTraceVertical(aTrace: TOrthoLine): Boolean;
begin
Result := False;
try
if DoubleCMP(aTrace.ActualPoints[1].x, aTrace.ActualPoints[2].x) then
Result := True;
except
on E: Exception do addExceptionToLogEx('U_Common.IfTraceVertical', E.Message);
end;
end;
function GetRaiseCountConnectedToFigure(AIDList, AIDFigure: Integer): Integer;
var
vList: TF_CAD;
vLine: TOrthoLine;
JoinConn: TConnectorObject;
begin
Result := 0;
try
vList := GetListByID(AIDList);
if vList <> nil then
begin
vLine := TOrthoLine(GetFigureByID(vList, AIDFigure));
if vLine <> nil then
begin
JoinConn := TConnectorObject(vLine.JoinConnector1);
if (JoinConn.FConnRaiseType = crt_BetweenFloorUp) or (JoinConn.FConnRaiseType = crt_BetweenFloorDown) or (JoinConn.FConnRaiseType = crt_TrunkUp) or (JoinConn.FConnRaiseType = crt_TrunkDown) then
Result := Result + 1;
JoinConn := TConnectorObject(vLine.JoinConnector2);
if (JoinConn.FConnRaiseType = crt_BetweenFloorUp) or (JoinConn.FConnRaiseType = crt_BetweenFloorDown) or (JoinConn.FConnRaiseType = crt_TrunkUp) or (JoinConn.FConnRaiseType = crt_TrunkDown) then
Result := Result + 1;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetRaiseCountConnectedToFigure', E.Message);
end;
end;
procedure SetAllBetweenFloorRaises;
var
i: Integer;
vFigure: TFigure;
vConn: TConnectorObject;
begin
try
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
vFigure := TFigure(GCadForm.PCad.Figures[i]);
if CheckFigureByClassName(vFigure, cTConnectorObject) then
begin
vConn := TConnectorObject(vFigure);
if vConn.FConnRaiseType = crt_BetweenFloorUp then
vConn.ActualZOrder[1] := GCadForm.FRoomHeight;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetAllBetweenFloorRaises', E.Message);
end;
end;
function IsNowTracingByUser: Boolean;
begin
Result := False;
try
if GCadForm.PCad.ToolIdx = toFigure then
Result := True;
except
on E: Exception do addExceptionToLogEx('U_Common.IsNowTracingByUser', E.Message);
end;
end;
//14.09.2010
//function IsMousedPressed: Boolean;
//var
// Button: TMouseButton;
//begin
// Result := False;
// try
// if Button = mbLeft then
// Result := True;
// except
// on E: Exception do addExceptionToLogEx('U_Common.IsMousedPressed', E.Message);
// end;
//end;
procedure ObjectsShiftUp(aObjList: TList);
var
i: integer;
CurObject: TConnectorObject;
AddDelta: Double;
CanMove: Boolean;
Shift: TShiftState;
temp: double;
begin
try
// ñäâèíóòü îáúåêòû
for i := 0 to aObjList.Count - 1 do
begin
CurObject := TConnectorObject(aObjList[i]);
Shift := KeyboardStateToShiftState;
if CurObject.DrawFigure.InFigures.Count > 0 then
begin
// Îáüåêò èç VISIO
if (CurObject.DrawFigure.InFigures.Count = 1) and CheckFigureByClassName(TFigure(CurObject.DrawFigure.InFigures[0]), 'TWMFObject') then
begin
if not(ssCtrl in Shift) then
begin
if IfDrawFigureMoveCan(CurObject, 0, - 0.1) then
begin
CurObject.DrawFigure.move(0, - 0.1);
CurObject.CaptionsGroup.Move(0, - 0.1);
end;
end
else
begin
if IfDrawFigureMoveCan(CurObject, 0, - CurObject.GrpSizeY / 2 + 0.6) then
begin
CurObject.DrawFigure.move(0, - CurObject.GrpSizeY / 2 + 0.6);
CurObject.CaptionsGroup.Move(0, - CurObject.GrpSizeY / 2 + 0.6);
end
else
begin
GCadForm.PCad.AutoRefresh := False;
CurObject.DrawFigure.move(0, CurObject.ActualPoints[1].y - CurObject.DrawFigure.CenterPoint.y);
CurObject.ReCreateCaptionsGroup(false, false);
CurObject.DrawFigure.move(0, - CurObject.GrpSizeY / 2 + 0.6);
CurObject.CaptionsGroup.Move(0, - CurObject.GrpSizeY / 2 + 0.6);
GCadForm.PCad.AutoRefresh := True;
end;
end;
end
// Îáúåêò èç POWERCAD
else
begin
if not(ssCtrl in Shift) then
begin
if IfDrawFigureMoveCan(CurObject, 0, - 0.1) then
begin
CurObject.DrawFigure.move(0, - 0.1);
CurObject.CaptionsGroup.Move(0, - 0.1);
end;
end
else
begin
if IfDrawFigureMoveCan(CurObject, 0, - CurObject.GrpSizeY / 2) then
begin
CurObject.DrawFigure.move(0, - CurObject.GrpSizeY / 2);
CurObject.CaptionsGroup.Move(0, - CurObject.GrpSizeY / 2);
end
else
begin
GCadForm.PCad.AutoRefresh := False;
CurObject.DrawFigure.move(0, CurObject.ActualPoints[1].y - CurObject.DrawFigure.CenterPoint.y);
CurObject.ReCreateCaptionsGroup(false, false);
CurObject.DrawFigure.move(0, - CurObject.GrpSizeY / 2);
CurObject.CaptionsGroup.Move(0, - CurObject.GrpSizeY / 2);
GCadForm.PCad.AutoRefresh := True;
end;
end;
end;
end
else
begin
if IfDrawFigureMoveCan(CurObject, 0, - CurObject.GrpSizeY / 2) then
begin
CurObject.DrawFigure.move(0, - CurObject.GrpSizeY / 2);
CurObject.CaptionsGroup.Move(0, - CurObject.GrpSizeY / 2);
end
else
begin
GCadForm.PCad.AutoRefresh := False;
CurObject.DrawFigure.move(0, CurObject.ActualPoints[1].y - CurObject.DrawFigure.CenterPoint.y);
CurObject.ReCreateCaptionsGroup(false, false);
CurObject.DrawFigure.move(0, - CurObject.GrpSizeY / 2);
CurObject.CaptionsGroup.Move(0, - CurObject.GrpSizeY / 2);
GCadForm.PCad.AutoRefresh := True;
end;
end;
CurObject.DefRaizeDrawFigurePos;
CurObject.FDrawFigureMoved := True;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ObjectsShiftUp', E.Message);
end;
end;
procedure ObjectsShiftDown(aObjList: TList);
var
i: integer;
CurObject: TConnectorObject;
AddDelta: Double;
CanMove: Boolean;
Shift: TShiftState;
begin
try
// ñäâèíóòü îáúåêòû
for i := 0 to aObjList.Count - 1 do
begin
CurObject := TConnectorObject(aObjList[i]);
Shift := KeyboardStateToShiftState;
if CurObject.DrawFigure.InFigures.Count > 0 then
begin
// Îáüåêò èç VISIO
if (CurObject.DrawFigure.InFigures.Count = 1) and CheckFigureByClassName(TFigure(CurObject.DrawFigure.InFigures[0]), 'TWMFObject') then
begin
if not (ssCtrl in Shift) then
begin
if IfDrawFigureMoveCan(CurObject, 0, 0.1) then
begin
CurObject.DrawFigure.move(0, 0.1);
CurObject.CaptionsGroup.Move(0, 0.1);
end;
end
else
begin
if IfDrawFigureMoveCan(CurObject, 0, CurObject.GrpSizeY / 2 - 0.6) then
begin
CurObject.DrawFigure.move(0, CurObject.GrpSizeY / 2 - 0.6);
CurObject.CaptionsGroup.Move(0, CurObject.GrpSizeY / 2 - 0.6);
end
else
begin
GCadForm.PCad.AutoRefresh := False;
CurObject.DrawFigure.move(0, CurObject.ActualPoints[1].y - CurObject.DrawFigure.CenterPoint.y);
CurObject.ReCreateCaptionsGroup(false, false);
CurObject.DrawFigure.move(0, CurObject.GrpSizeY / 2 - 0.6);
CurObject.CaptionsGroup.Move(0, CurObject.GrpSizeY / 2 - 0.6);
GCadForm.PCad.AutoRefresh := True;
end;
end;
end
// Îáúåêò èç POWERCAD
else
begin
if not (ssCtrl in Shift) then
begin
if IfDrawFigureMoveCan(CurObject, 0, 0.1) then
begin
CurObject.DrawFigure.move(0, 0.1);
CurObject.CaptionsGroup.Move(0, 0.1);
end;
end
else
begin
if IfDrawFigureMoveCan(CurObject, 0, CurObject.GrpSizeY / 2) then
begin
CurObject.DrawFigure.move(0, CurObject.GrpSizeY / 2);
CurObject.CaptionsGroup.Move(0, CurObject.GrpSizeY / 2);
end
else
begin
GCadForm.PCad.AutoRefresh := False;
CurObject.DrawFigure.move(0, CurObject.ActualPoints[1].y - CurObject.DrawFigure.CenterPoint.y);
CurObject.ReCreateCaptionsGroup(false, false);
CurObject.DrawFigure.move(0, CurObject.GrpSizeY / 2);
CurObject.CaptionsGroup.Move(0, CurObject.GrpSizeY / 2);
GCadForm.PCad.AutoRefresh := True;
end;
end;
end;
end
else
begin
if IfDrawFigureMoveCan(CurObject, 0, CurObject.GrpSizeY / 2) then
begin
CurObject.DrawFigure.move(0, CurObject.GrpSizeY / 2);
CurObject.CaptionsGroup.Move(0, CurObject.GrpSizeY / 2);
end
else
begin
GCadForm.PCad.AutoRefresh := False;
CurObject.DrawFigure.move(0, CurObject.ActualPoints[1].y - CurObject.DrawFigure.CenterPoint.y);
CurObject.ReCreateCaptionsGroup(false, false);
CurObject.DrawFigure.move(0, CurObject.GrpSizeY / 2);
CurObject.CaptionsGroup.Move(0, CurObject.GrpSizeY / 2);
GCadForm.PCad.AutoRefresh := True;
end;
end;
CurObject.DefRaizeDrawFigurePos;
CurObject.FDrawFigureMoved := True;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ObjectsShiftDown', E.Message);
end;
end;
procedure ObjectsShiftLeft(aObjList: TList);
var
i: integer;
CurObject: TConnectorObject;
AddDelta: Double;
CanMove: Boolean;
Shift: TShiftState;
begin
try
// ñäâèíóòü îáúåêòû
for i := 0 to aObjList.Count - 1 do
begin
CurObject := TConnectorObject(aObjList[i]);
Shift := KeyboardStateToShiftState;
if CurObject.DrawFigure.InFigures.Count > 0 then
begin
// Îáüåêò èç VISIO
if (CurObject.DrawFigure.InFigures.Count = 1) and CheckFigureByClassName(TFigure(CurObject.DrawFigure.InFigures[0]), 'TWMFObject') then
begin
if not (ssCtrl in Shift) then
begin
if IfDrawFigureMoveCan(CurObject, - 0.1, 0) then
begin
CurObject.DrawFigure.move( - 0.1, 0);
CurObject.CaptionsGroup.Move( - 0.1, 0);
end;
end
else
begin
if IfDrawFigureMoveCan(CurObject, - CurObject.GrpSizeX / 2 + 0.6, 0) then
begin
CurObject.DrawFigure.move( - CurObject.GrpSizeX / 2 + 0.6, 0);
CurObject.CaptionsGroup.Move( - CurObject.GrpSizeX / 2 + 0.6, 0);
end
else
begin
GCadForm.PCad.AutoRefresh := False;
CurObject.DrawFigure.move(CurObject.ActualPoints[1].x - CurObject.DrawFigure.CenterPoint.x, 0);
CurObject.ReCreateCaptionsGroup(false, false);
CurObject.DrawFigure.move( - CurObject.GrpSizeX / 2 + 0.6, 0);
CurObject.CaptionsGroup.Move( - CurObject.GrpSizeX / 2 + 0.6, 0);
GCadForm.PCad.AutoRefresh := True;
end;
end;
end
// Îáúåêò èç POWERCAD
else
begin
if not (ssCtrl in Shift) then
begin
if IfDrawFigureMoveCan(CurObject, - 0.1, 0) then
begin
CurObject.DrawFigure.move( - 0.1, 0);
CurObject.CaptionsGroup.Move( - 0.1, 0);
end;
end
else
begin
if IfDrawFigureMoveCan(CurObject, - CurObject.GrpSizeX / 2, 0) then
begin
CurObject.DrawFigure.move( - CurObject.GrpSizeX / 2, 0);
CurObject.CaptionsGroup.Move( - CurObject.GrpSizeX / 2, 0);
end
else
begin
GCadForm.PCad.AutoRefresh := False;
CurObject.DrawFigure.move(CurObject.ActualPoints[1].x - CurObject.DrawFigure.CenterPoint.x, 0);
CurObject.ReCreateCaptionsGroup(false, false);
CurObject.DrawFigure.move( - CurObject.GrpSizeX / 2, 0);
CurObject.CaptionsGroup.Move( - CurObject.GrpSizeX / 2, 0);
GCadForm.PCad.AutoRefresh := True;
end;
end;
end;
end
else
begin
if IfDrawFigureMoveCan(CurObject, - CurObject.GrpSizeX / 2, 0) then
begin
CurObject.DrawFigure.move( - CurObject.GrpSizeX / 2, 0);
CurObject.CaptionsGroup.Move( - CurObject.GrpSizeX / 2, 0);
end
else
begin
GCadForm.PCad.AutoRefresh := False;
CurObject.DrawFigure.move(CurObject.ActualPoints[1].x - CurObject.DrawFigure.CenterPoint.x, 0);
CurObject.ReCreateCaptionsGroup(false, false);
CurObject.DrawFigure.move( - CurObject.GrpSizeX / 2, 0);
CurObject.CaptionsGroup.Move( - CurObject.GrpSizeX / 2, 0);
GCadForm.PCad.AutoRefresh := True;
end;
end;
CurObject.DefRaizeDrawFigurePos;
CurObject.FDrawFigureMoved := True;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ObjectsShiftLeft', E.Message);
end;
end;
procedure ObjectsShiftRight(aObjList: TList);
var
i: integer;
CurObject: TConnectorObject;
AddDelta: Double;
CanMove: Boolean;
tmpfig: TFigureGrp;
Shift: TShiftState;
begin
try
// ñäâèíóòü îáúåêòû
for i := 0 to aObjList.Count - 1 do
begin
CurObject := TConnectorObject(aObjList[i]);
Shift := KeyboardStateToShiftState;
if CurObject.DrawFigure.InFigures.Count > 0 then
begin
// Îáüåêò èç VISIO
if (CurObject.DrawFigure.InFigures.Count = 1) and CheckFigureByClassName(TFigure(CurObject.DrawFigure.InFigures[0]), 'TWMFObject') then
begin
if not (ssCtrl in Shift) then
begin
if IfDrawFigureMoveCan(CurObject, 0.1, 0) then
begin
CurObject.DrawFigure.move(0.1, 0);
CurObject.CaptionsGroup.Move(0.1, 0);
end;
end
else
begin
if IfDrawFigureMoveCan(CurObject, CurObject.GrpSizeX / 2 - 0.6, 0) then
begin
CurObject.DrawFigure.move(CurObject.GrpSizeX / 2 - 0.6, 0);
CurObject.CaptionsGroup.Move(CurObject.GrpSizeX / 2 - 0.6, 0);
end
else
begin
GCadForm.PCad.AutoRefresh := False;
CurObject.DrawFigure.move(CurObject.ActualPoints[1].x - CurObject.DrawFigure.CenterPoint.x, 0);
CurObject.ReCreateCaptionsGroup(false, false);
CurObject.DrawFigure.move(CurObject.GrpSizeX / 2 - 0.6, 0);
CurObject.CaptionsGroup.Move(CurObject.GrpSizeX / 2 - 0.6, 0);
GCadForm.PCad.AutoRefresh := True;
end;
end
end
// Îáúåêò èç POWERCAD
else
begin
if not (ssCtrl in Shift) then
begin
if IfDrawFigureMoveCan(CurObject, 0.1, 0) then
begin
CurObject.DrawFigure.move(0.1, 0);
CurObject.CaptionsGroup.Move(0.1, 0);
end;
end
else
begin
if IfDrawFigureMoveCan(CurObject, CurObject.GrpSizeX / 2, 0) then
begin
CurObject.DrawFigure.move(CurObject.GrpSizeX / 2, 0);
CurObject.CaptionsGroup.Move(CurObject.GrpSizeX / 2, 0);
end
else
begin
GCadForm.PCad.AutoRefresh := False;
CurObject.DrawFigure.move(CurObject.ActualPoints[1].x - CurObject.DrawFigure.CenterPoint.x, 0);
CurObject.ReCreateCaptionsGroup(false, false);
CurObject.DrawFigure.move(CurObject.GrpSizeX / 2, 0);
CurObject.CaptionsGroup.Move(CurObject.GrpSizeX / 2, 0);
GCadForm.PCad.AutoRefresh := True;
end;
end
end
end
else
begin
if IfDrawFigureMoveCan(CurObject, CurObject.GrpSizeX / 2, 0) then
begin
CurObject.DrawFigure.move(CurObject.GrpSizeX / 2, 0);
CurObject.CaptionsGroup.Move(CurObject.GrpSizeX / 2, 0);
end
else
begin
GCadForm.PCad.AutoRefresh := False;
CurObject.DrawFigure.move(CurObject.ActualPoints[1].x - CurObject.DrawFigure.CenterPoint.x, 0);
CurObject.ReCreateCaptionsGroup(false, false);
CurObject.DrawFigure.move(CurObject.GrpSizeX / 2, 0);
CurObject.CaptionsGroup.Move(CurObject.GrpSizeX / 2, 0);
GCadForm.PCad.AutoRefresh := True;
end;
end;
CurObject.DefRaizeDrawFigurePos;
CurObject.FDrawFigureMoved := True;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.ObjectsShiftRight', E.Message);
end;
end;
procedure LinesShiftUp(aLinesList: TList);
var
i: Integer;
CurrLine: TOrthoLine;
Bnd: TDoubleRect;
AngleDegrees, AngleRad: Double;
dx, dy: double;
oldCP, newCP: TDoublePoint;
delta: double;
begin
try
delta := 0.1;
for i := 0 to aLinesList.Count - 1 do
begin
CurrLine := TOrthoLine(aLinesList[i]);
if (CurrLine.DrawFigure <> nil) and (CurrLine.DrawFigure.InFigures.Count > 0) then
begin
// ïîëó÷èòü ñòàðóþ öåíòð òî÷êó DrawFigure
Bnd := CurrLine.DrawFigure.GetBoundRect;
oldCP.x := (Bnd.Left + Bnd.Right) / 2;
oldCP.y := (Bnd.Top + Bnd.Bottom) / 2;
// ïîëó÷èòü òî÷êó ïåðåñå÷åíèÿ
AngleDegrees := CurrLine.GetAngle(CurrLine.ActualPoints[1].x, CurrLine.ActualPoints[1].y, CurrLine.ActualPoints[2].x, CurrLine.ActualPoints[2].y);
AngleRad := AngleDegrees * pi / 180;
// ïîëó÷èòü òî÷êó äëÿ ïåðåìåùåíèÿ
AngleDegrees := AngleDegrees + 90;
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 CurrLine.FIsRotated then
begin
dx := -dx;
dy := -dy;
end;
newCP.x := oldCP.x + dx;
newCP.y := oldCP.y + dy;
CurrLine.DrawFigure.move(newCP.x - oldCP.x, newCP.y - oldCP.y);
CurrLine.DrawFigureH := CurrLine.CalcHDrawFigure;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.LinesShiftUp', E.Message);
end;
end;
procedure LinesShiftDown(aLinesList: TList);
var
i: Integer;
CurrLine: TOrthoLine;
Bnd: TDoubleRect;
AngleDegrees, AngleRad: Double;
dx, dy: double;
oldCP, newCP: TDoublePoint;
delta: double;
begin
try
delta := 0.1;
for i := 0 to aLinesList.Count - 1 do
begin
CurrLine := TOrthoLine(aLinesList[i]);
if (CurrLine.DrawFigure <> nil) and (CurrLine.DrawFigure.InFigures.Count > 0) then
begin
// ïîëó÷èòü ñòàðóþ öåíòð òî÷êó DrawFigure
Bnd := CurrLine.DrawFigure.GetBoundRect;
oldCP.x := (Bnd.Left + Bnd.Right) / 2;
oldCP.y := (Bnd.Top + Bnd.Bottom) / 2;
// ïîëó÷èòü òî÷êó ïåðåñå÷åíèÿ
AngleDegrees := CurrLine.GetAngle(CurrLine.ActualPoints[1].x, CurrLine.ActualPoints[1].y, CurrLine.ActualPoints[2].x, CurrLine.ActualPoints[2].y);
AngleRad := AngleDegrees * pi / 180;
// ïîëó÷èòü òî÷êó äëÿ ïåðåìåùåíèÿ
AngleDegrees := AngleDegrees + 90;
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 CurrLine.FIsRotated then
begin
dx := -dx;
dy := -dy;
end;
newCP.x := oldCP.x + dx;
newCP.y := oldCP.y + dy;
CurrLine.DrawFigure.move(newCP.x - oldCP.x, newCP.y - oldCP.y);
CurrLine.DrawFigureH := CurrLine.CalcHDrawFigure;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.LinesShiftDown', E.Message);
end;
end;
procedure LinesShiftLeft(aLinesList: TList);
var
i: Integer;
CurrLine: TOrthoLine;
Bnd: TDoubleRect;
AngleDegrees, AngleRad: Double;
dx, dy: double;
oldCP, newCP: TDoublePoint;
delta: double;
begin
try
delta := 0.1;
for i := 0 to aLinesList.Count - 1 do
begin
CurrLine := TOrthoLine(aLinesList[i]);
if (CurrLine.DrawFigure <> nil) and (CurrLine.DrawFigure.InFigures.Count > 0) then
begin
// ïîëó÷èòü ñòàðóþ öåíòð òî÷êó DrawFigure
Bnd := CurrLine.DrawFigure.GetBoundRect;
oldCP.x := (Bnd.Left + Bnd.Right) / 2;
oldCP.y := (Bnd.Top + Bnd.Bottom) / 2;
// ïîëó÷èòü òî÷êó ïåðåñå÷åíèÿ
AngleDegrees := CurrLine.GetAngle(CurrLine.ActualPoints[1].x, CurrLine.ActualPoints[1].y, CurrLine.ActualPoints[2].x, CurrLine.ActualPoints[2].y);
AngleRad := AngleDegrees * pi / 180;
// ïîëó÷èòü òî÷êó äëÿ ïåðåìåùåíèÿ
AngleDegrees := AngleDegrees + 90;
AngleDegrees := round(AngleDegrees) mod 360;
AngleRad := AngleDegrees * pi / 180;
if ((AngleDegrees >= 0) and (AngleDegrees < 90)) then
begin
dx := - (delta * Cos(AngleRad));
dy := - (delta * Sin(AngleRad));
end;
if ((AngleDegrees >= 90) and (AngleDegrees < 180)) then
begin
dx := (delta * Cos(AngleRad));
dy := (delta * Sin(AngleRad));
end;
if ((AngleDegrees >= 180) and (AngleDegrees < 270)) then
begin
dx := - (delta * Cos(AngleRad));
dy := - (delta * Sin(AngleRad));
end;
if ((AngleDegrees >= 270) and (AngleDegrees < 360)) then
begin
dx := (delta * Cos(AngleRad));
dy := (delta * Sin(AngleRad));
end;
if (AngleDegrees >= 180) and (AngleDegrees < 360) then
begin
dx := -dx;
dy := -dy;
end;
// åñëè ïîâîðîò íà 180 òî ïåðåáðîñèòü ëèíèþ íà äðóãóþ ñòîðîíó
if CurrLine.FIsRotated then
begin
dx := -dx;
dy := -dy;
end;
newCP.x := oldCP.x + dx;
newCP.y := oldCP.y + dy;
CurrLine.DrawFigure.move(newCP.x - oldCP.x, newCP.y - oldCP.y);
CurrLine.DrawFigureH := CurrLine.CalcHDrawFigure;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.LinesShiftLeft', E.Message);
end;
end;
procedure LinesShiftRight(aLinesList: TList);
var
i: Integer;
CurrLine: TOrthoLine;
Bnd: TDoubleRect;
AngleDegrees, AngleRad: Double;
dx, dy: double;
oldCP, newCP: TDoublePoint;
delta: double;
begin
try
delta := 0.1;
for i := 0 to aLinesList.Count - 1 do
begin
CurrLine := TOrthoLine(aLinesList[i]);
if (CurrLine.DrawFigure <> nil) and (CurrLine.DrawFigure.InFigures.Count > 0) then
begin
// ïîëó÷èòü ñòàðóþ öåíòð òî÷êó DrawFigure
Bnd := CurrLine.DrawFigure.GetBoundRect;
oldCP.x := (Bnd.Left + Bnd.Right) / 2;
oldCP.y := (Bnd.Top + Bnd.Bottom) / 2;
// ïîëó÷èòü òî÷êó ïåðåñå÷åíèÿ
AngleDegrees := CurrLine.GetAngle(CurrLine.ActualPoints[1].x, CurrLine.ActualPoints[1].y, CurrLine.ActualPoints[2].x, CurrLine.ActualPoints[2].y);
AngleRad := AngleDegrees * pi / 180;
// ïîëó÷èòü òî÷êó äëÿ ïåðåìåùåíèÿ
AngleDegrees := AngleDegrees + 90;
AngleDegrees := round(AngleDegrees) mod 360;
AngleRad := AngleDegrees * pi / 180;
if ((AngleDegrees >= 0) and (AngleDegrees < 90)) then
begin
dx := (delta * Cos(AngleRad));
dy := (delta * Sin(AngleRad));
end;
if ((AngleDegrees >= 90) and (AngleDegrees < 180)) then
begin
dx := - (delta * Cos(AngleRad));
dy := - (delta * Sin(AngleRad));
end;
if ((AngleDegrees >= 180) and (AngleDegrees < 270)) then
begin
dx := (delta * Cos(AngleRad));
dy := (delta * Sin(AngleRad));
end;
if ((AngleDegrees >= 270) and (AngleDegrees < 360)) then
begin
dx := - (delta * Cos(AngleRad));
dy := - (delta * Sin(AngleRad));
end;
if (AngleDegrees >= 180) and (AngleDegrees < 360) then
begin
dx := -dx;
dy := -dy;
end;
// åñëè ïîâîðîò íà 180 òî ïåðåáðîñèòü ëèíèþ íà äðóãóþ ñòîðîíó
if CurrLine.FIsRotated then
begin
dx := -dx;
dy := -dy;
end;
newCP.x := oldCP.x + dx;
newCP.y := oldCP.y + dy;
CurrLine.DrawFigure.move(newCP.x - oldCP.x, newCP.y - oldCP.y);
CurrLine.DrawFigureH := CurrLine.CalcHDrawFigure;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.LinesShiftRight', E.Message);
end;
end;
procedure SetIsCableChannel(aListID, aLineID: Integer; aFlag: Boolean);
var
vList: TF_CAD;
vLine: TOrthoLine;
begin
try
vList := GetListByID(aListID);
if vList <> nil then
begin
vLine := TOrthoLine(GetFigureByID(vList, aLineID));
if vLine <> nil then
vLine.FIsCableChannel := aFlag;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SetIsCableChannel', E.Message);
end;
end;
procedure SaveForProjectUndo(aLists: TList; aSavePM: Boolean; aIsProject: Boolean);
var
i, j: integer;
vList: TF_CAD;
ProjectUndoAction: TProjectUndoAction;
ListUndoAction: TListUndoAction;
LinkUndoObject: TLinkUndoObject;
SavedGCadForm: TF_CAD;
begin
try
if GUndoList = nil then
GUndoList := TList.Create;
ProjectUndoAction := TProjectUndoAction.create;
SavedGCadForm := GCadForm;
for i := 0 to aLists.Count - 1 do
begin
vList := TF_CAD(aLists[i]);
GCadForm := vList;
ListUndoAction := nil; //#From Oleg# //14.09.2010
//
if vList.FListType = lt_Normal then
ListUndoAction := vList.SaveForUndoNormalList(uat_Floor, aSavePM, aIsProject, i)
else
if vList.FListType = lt_ProjectPlan then
ListUndoAction := vList.SaveForUndoProjectPlan(uat_Floor, aSavePM, aIsProject, i)
else
if vList.FListType = lt_DesignBox then
ListUndoAction := vList.SaveForUndoDesignList(uat_Floor, aSavePM, aIsProject, i);
// ListUndoAction := vList.SaveForUndo(uat_Floor, aSavePM, aIsProject, i);
//
if ListUndoAction <> nil then
begin
ListUndoAction.FProjectUndoAction := ProjectUndoAction;
LinkUndoObject := TLinkUndoObject.create;
LinkUndoObject.FCad := vList;
LinkUndoObject.FListUndoAction := ListUndoAction;
ProjectUndoAction.FLinkUndoObject.Add(LinkUndoObject);
end;
end;
GCadForm := SavedGCadForm;
GUndoList.Add(ProjectUndoAction);
except
on E: Exception do addExceptionToLogEx('U_Common.SaveForProjectUndo', E.Message);
end;
end;
procedure DeleteProjectUndoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction);
var
i, j: integer;
vList: TF_CAD;
ProjectUndoAction: TProjectUndoAction;
ListUndoAction: TListUndoAction;
LinkUndoObject: TLinkUndoObject;
Index: Integer;
Count: Integer;
OldFName, FName: string;
SetUndoName: string;
begin
try
if GUndoList <> nil then
begin
ProjectUndoAction := aListUndoAction.FProjectUndoAction;
// óäàëèòü èç ãëîáàë ëèñòà
GUndoList.Remove(ProjectUndoAction);
// óäàëèòü ñî âñåõ ëèñòîâ
for i := 0 to ProjectUndoAction.FLinkUndoObject.Count - 1 do
begin
LinkUndoObject := TLinkUndoObject(ProjectUndoAction.FLinkUndoObject[i]);
vList := LinkUndoObject.FCad;
ListUndoAction := LinkUndoObject.FListUndoAction;
//Index := -1;
//if vList.FSCSUndoList <> nil then
// Index := vList.FSCSUndoList.IndexOf(ListUndoAction);
Index := vList.FSCSUndoList.IndexOf(ListUndoAction);
// ýòîò Undo íå ñ òåêóùåãî ëèñòà (îí óæå îáðàáîòàò)
if ListUndoAction <> aListUndoAction then
begin
// óäàëèòü ñ óêàçàííîãî ëèñòà íóæíûé Undo è âñå ÷òî ïåðåä íèì
while Index >= 0 do
begin
ListUndoAction := TListUndoAction(vList.FSCSUndoList[Index]);
FName := ListUndoAction.FCadFileName;
// óäàëèòü ôàéë
if FileExists(FName) then
DeleteFile(FName);
// óäàëèòü ýëåìåíò èç ñïèñêà ôàéëîâ
vList.FSCSUndoList.Delete(Index);
// *UNDO ProjectManager*
DeleteUndoFromPM(vList.FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject);
FreeAndNil(ListUndoAction);
Index := Index - 1;
end;
// ïåðåïðèñâîèòü èìåíà ôàéëîâ ñ ó÷åòîì ñìåùåíèÿ
for j := 0 to vList.FSCSUndoList.Count - 1 do
begin
ListUndoAction := TListUndoAction(vList.FSCSUndoList[j]);
// FName := vList.FUndoDir + vList.FCADListName + IntTostr(vList.FCADListIndex) + '_' + IntToStr(j);
FName := vList.FUndoDir + vList.FCADListFileName + '_' + IntToStr(j);
OldFName := ListUndoAction.FCadFileName;
RenameFile(OldFName, FName);
ListUndoAction.FCadFileName := FName;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.DeleteProjectUndoActions', E.Message);
end;
end;
procedure LoadProjectUndoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction);
var
i, j, k, l: integer;
vList: TF_CAD;
ProjectUndoAction: TProjectUndoAction;
ListUndoAction, DelListUndoAction: TListUndoAction;
LinkUndoObject: TLinkUndoObject;
Index: Integer;
Count: Integer;
FName: string;
SetUndoName: string;
Stream: TMemoryStream;
size: integer;
SavedGCadForm: TF_CAD;
CountInPrj: Integer;
ListIndex: Integer;
CurListParams: TListParams;
ListOfLists: TList;
Figure: TFigure;
//Tolik
CadFigList: TList;
//
begin
try
if GUndoList <> nil then
begin
ProjectUndoAction := aListUndoAction.FProjectUndoAction;
// óäàëèòü èç ãëîáàë ëèñòà
GUndoList.Remove(ProjectUndoAction);
// óäàëèòü ñî âñåõ ëèñòîâ
SavedGCadForm := GCadForm;
ListIndex := 1;
for i := 0 to ProjectUndoAction.FLinkUndoObject.Count - 1 do
begin
LinkUndoObject := TLinkUndoObject(ProjectUndoAction.FLinkUndoObject[i]);
vList := LinkUndoObject.FCad;
ListUndoAction := LinkUndoObject.FListUndoAction;
Index := vList.FSCSUndoList.IndexOf(ListUndoAction);
// ýòîò Undo íå ñ òåêóùåãî ëèñòà (îí óæå îáðàáîòàí)
if ListUndoAction <> aListUndoAction then
begin
// óäàëèòü ñ óêàçàííîãî ëèñòà âñå ÷òî ïîñëå ýòîãî Undo
j := vList.FSCSUndoList.Count - 1;
while j > Index do
begin
DelListUndoAction := TListUndoAction(vList.FSCSUndoList[j]);
FName := DelListUndoAction.FCadFileName;
// óäàëèòü ôàéë
if FileExists(FName) then
DeleteFile(FName);
// óäàëèòü ýëåìåíò èç ñïèñêà ôàéëîâ
vList.FSCSUndoList.Delete(j);
FreeAndNil(DelListUndoAction);
j := j - 1;
end;
GCadForm := vList;
FName := ListUndoAction.FCadFileName;
if FileExists(FName) then
begin
// ïîäíÿòü òåìïîâûé ôàéë
if GCadForm.FListType = lt_Normal then
GCadForm.ClearSCSFigures
else
GCadForm.ClearPlanFigures;
GCadForm.PCad.OnObjectInserted := nil;
GCadForm.FUndoFiguresList.Clear;
GCadForm.PCad.LoadSCSFiguresFromFile(FName);
GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted;
GCadForm.FUndoStatus := True;
try
if GListWithEndPoint = GCadForm then
begin
GEndPoint := nil;
GListWithEndPoint := nil;
end;
GNeedReRaiseProperties := False;
//Tolik
CadFigList := TList.Create;
for k := 0 to GCadForm.PCad.FigureCount - 1 do
CadFigList.Add(TFigure(GCadForm.PCad.Figures.Items[k]));
for k := 0 to CadFigList.Count - 1 do
begin
Figure := TFigure(CadFigList[k]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
TConnectorObject(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTOrthoLine) then
TOrthoLine(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then
TSCSFigureGrp(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTCabinet) then
TCabinet(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTCabinetExt) then
TCabinetExt(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTHouse) then
THouse(Figure).RaiseProperties(CadFigList);
end;
FreeAndNil(CadFigList);
{
for k := 0 to GCadForm.PCad.FigureCount - 1 do
begin
Figure := TFigure(GCadForm.PCad.Figures.Items[k]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
TConnectorObject(Figure).RaiseProperties
else if CheckFigureByClassName(Figure, cTOrthoLine) then
TOrthoLine(Figure).RaiseProperties
else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then
TSCSFigureGrp(Figure).RaiseProperties
else if CheckFigureByClassName(Figure, cTCabinet) then
TCabinet(Figure).RaiseProperties
else if CheckFigureByClassName(Figure, cTCabinetExt) then
TCabinetExt(Figure).RaiseProperties
else if CheckFigureByClassName(Figure, cTHouse) then
THouse(Figure).RaiseProperties;
end;
if GNeedReRaiseProperties then
begin
k := 0;
while k < GCadForm.PCad.FigureCount do
begin
Figure := TFigure(GCadForm.PCad.Figures.Items[k]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
TConnectorObject(Figure).ReRaiseProperties;
end;
if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
TOrthoLine(Figure).ReRaiseProperties;
end;
k := k + 1;
end;
end;
}
finally
GCadForm.FUndoStatus := False;
end;
FindObjectsForConvertClasses;
// óäàëèòü ôàéë
if FileExists(FName) then
DeleteFile(FName);
// óäàëèòü ïîñëåäíèé êîòîðûé ïîäíèìàåòñÿ èç ñïèêà
GCadForm.FSCSUndoList.Delete(vList.FSCSUndoList.Count - 1);
if ListUndoAction.ActionType = uat_Floor then
begin
CountInPrj := 0;
ListOfLists := TList.Create;
for l := 0 to ListUndoAction.FProjectUndoAction.FLinkUndoObject.Count - 1 do
begin
LinkUndoObject := TLinkUndoObject(ListUndoAction.FProjectUndoAction.FLinkUndoObject[l]);
if LinkUndoObject.FCad.FListType = lt_Normal then
begin
CountInPrj := CountInPrj + 1;
end;
end;
end
else
CountInPrj := 1;
// *UNDO ProjectManager*
UndoListInPM(GCadForm.FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject, ListIndex, CountInPrj);
CurListParams := GetListParams(GCadForm.FCADListID);
LoadSettingsForListByParams(CurListParams, False);
end;
// óäàëèòü îáúåêò UndoAction
FreeAndNil(ListUndoAction);
ListIndex := ListIndex + 1;
end;
end;
GcadForm := SavedGCadForm;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.LoadProjectUndoActions', E.Message);
end;
end;
procedure SaveForUndoFromPM(aListsIDs: TIntList; aIsProject: Boolean = False);
var
i, j: integer;
vList: TF_CAD;
ID: Integer;
vLists: TList;
begin
try
if (aListsIDs <> nil) and (aListsIDs.Count > 0) then
begin
// ñîõðàíåíèå îäíîãî ëèñòà
if aListsIDs.Count = 1 then
begin
ID := aListsIDs[0];
ReOpenListInCADIfClosed(ID, ''); //17.08.2012
vList := GetListByID(ID);
if vList <> nil then
vList.SaveForUndo(uat_None, True, aIsProject);
end
else
// ñîõðàííèå íåñêîëüêèõ ëèñòîâ
begin
vLists := TList.Create;
for i := 0 to aListsIDs.Count - 1 do
begin
ID := aListsIDs[i];
ReOpenListInCADIfClosed(ID, ''); //17.08.2012
vList := GetListByID(ID);
if vList <> nil then
vLists.Add(vList);
end;
SaveForProjectUndo(vLists, True, aIsProject);
FreeAndNil(vLists);
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.SaveForUndoFromPM', E.Message);
end;
end;
procedure SaveForProjectRedo(aLists: TList; aSavePM: Boolean; aIsProject: Boolean);
var
i, j: integer;
vList: TF_CAD;
ProjectUndoAction: TProjectUndoAction;
ListUndoAction: TListUndoAction;
LinkUndoObject: TLinkUndoObject;
SavedGCadForm: TF_CAD;
begin
try
if GRedoList = nil then
GRedoList := TList.Create;
ProjectUndoAction := TProjectUndoAction.create;
SavedGCadForm := GCadForm;
for i := 0 to aLists.Count - 1 do
begin
vList := TF_CAD(aLists[i]);
GCadForm := vList;
ListUndoAction := vList.SaveForRedo(uat_Floor, aSavePM, aIsProject, i);
if ListUndoAction <> nil then
begin
ListUndoAction.FProjectUndoAction := ProjectUndoAction;
LinkUndoObject := TLinkUndoObject.create;
LinkUndoObject.FCad := vList;
LinkUndoObject.FListUndoAction := ListUndoAction;
ProjectUndoAction.FLinkUndoObject.Add(LinkUndoObject);
end;
end;
GCadForm := SavedGCadForm;
GRedoList.Add(ProjectUndoAction);
except
on E: Exception do AddExceptionToLogEx('U_Common.SaveForProjectRedo', E.Message);
end;
end;
procedure DeleteProjectRedoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction);
var
i, j: integer;
vList: TF_CAD;
ProjectUndoAction: TProjectUndoAction;
ListUndoAction: TListUndoAction;
LinkUndoObject: TLinkUndoObject;
Index: Integer;
Count: Integer;
OldFName, FName: string;
SetUndoName: string;
begin
try
if GRedoList <> nil then
begin
ProjectUndoAction := aListUndoAction.FProjectUndoAction;
// óäàëèòü èç ãëîáàë ëèñòà
GRedoList.Remove(ProjectUndoAction);
// óäàëèòü ñî âñåõ ëèñòîâ
for i := 0 to ProjectUndoAction.FLinkUndoObject.Count - 1 do
begin
LinkUndoObject := TLinkUndoObject(ProjectUndoAction.FLinkUndoObject[i]);
vList := LinkUndoObject.FCad;
ListUndoAction := LinkUndoObject.FListUndoAction;
Index := vList.FSCSRedoList.IndexOf(ListUndoAction);
// ýòîò Undo íå ñ òåêóùåãî ëèñòà (îí óæå îáðàáîòàò)
if ListUndoAction <> aListUndoAction then
begin
// óäàëèòü ñ óêàçàííîãî ëèñòà íóæíûé Redo è âñå ÷òî ïåðåä íèì
while Index >= 0 do
begin
ListUndoAction := TListUndoAction(vList.FSCSRedoList[Index]);
FName := ListUndoAction.FCadFileName;
// óäàëèòü ôàéë
if FileExists(FName) then
DeleteFile(FName);
// óäàëèòü ýëåìåíò èç ñïèñêà ôàéëîâ
vList.FSCSRedoList.Delete(Index);
// *UNDO ProjectManager*
DeleteUndoFromPM(vList.FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject);
FreeAndNil(ListUndoAction);
Index := Index - 1;
end;
// ïåðåïðèñâîèòü èìåíà ôàéëîâ ñ ó÷åòîì ñìåùåíèÿ
for j := 0 to vList.FSCSRedoList.Count - 1 do
begin
ListUndoAction := TListUndoAction(vList.FSCSRedoList[j]);
// FName := vList.FRedoDir + vList.FCADListName + IntTostr(vList.FCADListIndex) + '_' + IntToStr(j);
FName := vList.FRedoDir + vList.FCADListFileName + '_' + IntToStr(j);
OldFName := ListUndoAction.FCadFileName;
RenameFile(OldFName, FName);
ListUndoAction.FCadFileName := FName;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.DeleteProjectRedoActions', E.Message);
end;
end;
procedure LoadProjectRedoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction);
var
i, j, k: integer;
vList: TF_CAD;
ProjectUndoAction: TProjectUndoAction;
ListUndoAction, DelListUndoAction: TListUndoAction;
LinkUndoObject: TLinkUndoObject;
Index: Integer;
Count: Integer;
FName: string;
SetUndoName: string;
Stream: TMemoryStream;
size: integer;
SavedGCadForm: TF_CAD;
CountInPrj: Integer;
ListIndex: Integer;
CurListParams: TListParams;
Figure: TFigure;
//Tolik
CadFigList: TList;
//
begin
try
if GRedoList <> nil then
begin
ProjectUndoAction := aListUndoAction.FProjectUndoAction;
// óäàëèòü èç ãëîáàë ëèñòà
GRedoList.Remove(ProjectUndoAction);
// óäàëèòü ñî âñåõ ëèñòîâ
SavedGCadForm := GCadForm;
ListIndex := 1;
for i := 0 to ProjectUndoAction.FLinkUndoObject.Count - 1 do
begin
LinkUndoObject := TLinkUndoObject(ProjectUndoAction.FLinkUndoObject[i]);
vList := LinkUndoObject.FCad;
ListUndoAction := LinkUndoObject.FListUndoAction;
Index := vList.FSCSRedoList.IndexOf(ListUndoAction);
// ýòîò Undo íå ñ òåêóùåãî ëèñòà (îí óæå îáðàáîòàí)
if ListUndoAction <> aListUndoAction then
begin
// óäàëèòü ñ óêàçàííîãî ëèñòà âñå ÷òî ïîñëå ýòîãî Undo
j := vList.FSCSRedoList.Count - 1;
while j > Index do
begin
DelListUndoAction := TListUndoAction(vList.FSCSRedoList[j]);
FName := DelListUndoAction.FCadFileName;
// óäàëèòü ôàéë
if FileExists(FName) then
DeleteFile(FName);
// óäàëèòü ýëåìåíò èç ñïèñêà ôàéëîâ
vList.FSCSRedoList.Delete(j);
FreeAndNil(DelListUndoAction);
j := j - 1;
end;
GCadForm := vList;
FName := ListUndoAction.FCadFileName;
if FileExists(FName) then
begin
// ïîäíÿòü òåìïîâûé ôàéë
if GCadForm.FListType = lt_Normal then
GCadForm.ClearSCSFigures
else
GCadForm.ClearPlanFigures;
GCadForm.PCad.OnObjectInserted := nil;
GCadForm.FUndoFiguresList.Clear;
GCadForm.PCad.LoadSCSFiguresFromFile(FName);
GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted;
GCadForm.FUndoStatus := True;
try
if GListWithEndPoint = GCadForm then
begin
GEndPoint := nil;
GListWithEndPoint := nil;
end;
GNeedReRaiseProperties := False;
//Tolik
CadFigList := TList.create;
for k := 0 to GCadForm.PCad.FigureCount - 1 do
CadFigList.Add(TFigure(GCadForm.PCad.Figures.Items[k]));
for k := 0 to CadFigList.Count - 1 do
begin
Figure := TFigure(CadFigList[k]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
TConnectorObject(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTOrthoLine) then
TOrthoLine(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then
TSCSFigureGrp(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTCabinet) then
TCabinet(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTCabinetExt) then
TCabinetExt(Figure).RaiseProperties(CadFigList)
else if CheckFigureByClassName(Figure, cTHouse) then
THouse(Figure).RaiseProperties(CadFigList);
end;
FreeAndNil(CadFigList);
{
for k := 0 to GCadForm.PCad.FigureCount - 1 do
begin
Figure := TFigure(GCadForm.PCad.Figures.Items[k]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
TConnectorObject(Figure).RaiseProperties
else if CheckFigureByClassName(Figure, cTOrthoLine) then
TOrthoLine(Figure).RaiseProperties
else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then
TSCSFigureGrp(Figure).RaiseProperties
else if CheckFigureByClassName(Figure, cTCabinet) then
TCabinet(Figure).RaiseProperties
else if CheckFigureByClassName(Figure, cTCabinetExt) then
TCabinetExt(Figure).RaiseProperties
else if CheckFigureByClassName(Figure, cTHouse) then
THouse(Figure).RaiseProperties;
end;
if GNeedReRaiseProperties then
begin
k := 0;
while k < GCadForm.PCad.FigureCount do
begin
Figure := TFigure(GCadForm.PCad.Figures.Items[k]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
TConnectorObject(Figure).ReRaiseProperties;
end;
if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
TOrthoLine(Figure).ReRaiseProperties;
end;
k := k + 1;
end;
end;
}
finally
GCadForm.FUndoStatus := False;
end;
FindObjectsForConvertClasses;
// óäàëèòü ôàéë
if FileExists(FName) then
DeleteFile(FName);
// óäàëèòü ïîñëåäíèé êîòîðûé ïîäíèìàåòñÿ èç ñïèêà
GCadForm.FSCSRedoList.Delete(vList.FSCSRedoList.Count - 1);
if ListUndoAction.ActionType = uat_Floor then
CountInPrj := ListUndoAction.FProjectUndoAction.FLinkUndoObject.Count
else
CountInPrj := 1;
// *UNDO ProjectManager*
UndoListInPM(GCadForm.FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject, ListIndex, CountInPrj);
CurListParams := GetListParams(GCadForm.FCADListID);
LoadSettingsForListByParams(CurListParams, False);
end;
// óäàëèòü îáúåêò UndoAction
FreeAndNil(ListUndoAction);
ListIndex := ListIndex + 1;
end;
end;
GcadForm := SavedGCadForm;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.LoadProjectRedoActions', E.Message);
end;
end;
procedure SaveForRedoFromPM(aListsIDs: TIntList; aIsProject: Boolean = False);
var
i, j: integer;
vList: TF_CAD;
ID: Integer;
vLists: TList;
begin
try
if (aListsIDs <> nil) and (aListsIDs.Count > 0) then
begin
// ñîõðàíåíèå îäíîãî ëèñòà
if aListsIDs.Count = 1 then
begin
ID := aListsIDs[0];
vList := GetListByID(ID);
if vList <> nil then
vList.SaveForRedo(uat_None, True, aIsProject);
end
else
// ñîõðàííèå íåñêîëüêèõ ëèñòîâ
begin
vLists := TList.Create;
for i := 0 to aListsIDs.Count - 1 do
begin
ID := aListsIDs[i];
vList := GetListByID(ID);
if vList <> nil then
vLists.Add(vList);
end;
SaveForProjectRedo(vLists, True, aIsProject);
FreeAndNil(vLists);
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.SaveForRedoFromPM', E.Message);
end;
end;
function GetOtherListRelatedToFigure(AListID, AFigureID: Integer): Integer;
var
vList: TF_CAD;
vFigure: TFigure;
vConn: TConnectorObject;
vLine: TOrthoLine;
RaiseConn, Join1, Join2: TConnectorObject;
begin
Result := -1;
try
vList := GetListByID(AListID);
if vList <> nil then
begin
vFigure := GetFigureByID(vList, AFigureID);
if vFigure <> nil then
begin
// ÊÎÍÍÅÊÒÎÐ
if CheckFigureByClassName(vFigure, cTConnectorObject) then
begin
vConn := TConnectorObject(vFigure);
// ýòî âåðøèíà ìåæýòèàæíîãî ïåðåõîäà
if (vConn.FConnRaiseType = crt_BetweenFloorUp) or (vConn.FConnRaiseType = crt_BetweenFloorDown) or (vConn.FConnRaiseType = crt_TrunkUp) or (vConn.FConnRaiseType = crt_TrunkDown) then
begin
Result := vConn.FID_ListToPassage;
end
else
// íà ýòîì êîííåêòîðå åñòü âåðøèíà ìåæýòàæíîãî
begin
RaiseConn := GetRaiseConn(vConn);
if RaiseConn <> nil then
if (RaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (RaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (RaiseConn.FConnRaiseType = crt_TrunkUp) or (RaiseConn.FConnRaiseType = crt_TrunkDown) then
Result := RaiseConn.FID_ListToPassage;
end;
end
// ÎÐÒÎËÈÍÈß
else if CheckFigureByClassName(vFigure, cTOrthoLine) then
begin
vLine := TOrthoLine(vFigure);
if vLine.FIsRaiseUpDown then
begin
Join1 := TConnectorObject(vLine.JoinConnector1);
Join2 := TConnectorObject(vLine.JoinConnector2);
if (Join1.FConnRaiseType = crt_BetweenFloorUp) or (Join1.FConnRaiseType = crt_BetweenFloorDown) or (Join1.FConnRaiseType = crt_TrunkUp) or (Join1.FConnRaiseType = crt_TrunkDown) then
Result := Join1.FID_ListToPassage;
if (Join2.FConnRaiseType = crt_BetweenFloorUp) or (Join2.FConnRaiseType = crt_BetweenFloorDown) or (Join2.FConnRaiseType = crt_TrunkUp) or (Join2.FConnRaiseType = crt_TrunkDown) then
Result := Join2.FID_ListToPassage;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetOtherListRelatedToFigure', E.Message);
end;
end;
function GetRelatedListsBySelected(aObjects: TList; aCheckBySelectedType: TCheckBySelectedType): TList;
var
i, j: Integer;
vFigure: TFigure;
vConn: TConnectorObject;
vLine: TOrthoLine;
vList: TF_CAD;
RaiseConn, Join1, Join2: TConnectorObject;
begin
Result := TList.Create;
try
Result.Add(GCadForm);
for i := 0 to aObjects.Count - 1 do
begin
vFigure := TFigure(aOBjects[i]);
if CheckFigureByClassName(vFigure, cTConnectorObject) then
begin
vConn := TConnectorObject(vFigure);
// ýòî øêàô, êîòîðûé óäàëÿåòñÿ, íóæíî óäàëèòü ññûëêè íà ëèñò äèçàéíà øêàôà
if aCheckBySelectedType = cst_Delete then
if vConn.FJoinedListIDForBox <> - 1 then
vConn.FJoinedListIDForBox := - 1;
// ýòî âåðøèíà ìåæýòèàæíîãî ïåðåõîäà
if (vConn.FConnRaiseType = crt_BetweenFloorUp) or (vConn.FConnRaiseType = crt_BetweenFloorDown) or (vConn.FConnRaiseType = crt_TrunkUp) or (vConn.FConnRaiseType = crt_TrunkDown) then
begin
vList := GetListByID(vConn.FID_ListToPassage);
if vList <> nil then
if CheckNoCadInList(vList, Result) then
Result.Add(vList);
end
else
// íà ýòîì êîííåêòîðå åñòü âåðøèíà ìåæýòàæíîãî
begin
RaiseConn := GetRaiseConn(vConn);
if RaiseConn <> nil then
if (RaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (RaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (RaiseConn.FConnRaiseType = crt_TrunkUp) or (RaiseConn.FConnRaiseType = crt_TrunkDown) then
begin
vList := GetListByID(RaiseConn.FID_ListToPassage);
if vList <> nil then
if CheckNoCadInList(vList, Result) then
Result.Add(vList);
end;
end;
end
else if CheckFigureByClassName(vFigure, cTOrthoLine) then
begin
vLine := TOrthoLine(vFigure);
Join1 := TConnectorObject(vLine.JoinConnector1);
Join2 := TConnectorObject(vLine.JoinConnector2);
// ýòî âåðøèíà ìåæýòèàæíîãî ïåðåõîäà
if (Join1.FConnRaiseType = crt_BetweenFloorUp) or (Join1.FConnRaiseType = crt_BetweenFloorDown) or (Join1.FConnRaiseType = crt_TrunkUp) or (Join1.FConnRaiseType = crt_TrunkDown) then
begin
vList := GetListByID(Join1.FID_ListToPassage);
if vList <> nil then
if CheckNoCadInList(vList, Result) then
Result.Add(vList);
end
else
// íà ýòîì êîííåêòîðå åñòü âåðøèíà ìåæýòàæíîãî
if aCheckBySelectedType = cst_Move then
begin
RaiseConn := GetRaiseConn(Join1);
if RaiseConn <> nil then
if (RaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (RaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (RaiseConn.FConnRaiseType = crt_TrunkUp) or (RaiseConn.FConnRaiseType = crt_TrunkDown) then
begin
vList := GetListByID(RaiseConn.FID_ListToPassage);
if vList <> nil then
if CheckNoCadInList(vList, Result) then
Result.Add(vList);
end;
end;
// ýòî âåðøèíà ìåæýòèàæíîãî ïåðåõîäà
if (Join2.FConnRaiseType = crt_BetweenFloorUp) or (Join2.FConnRaiseType = crt_BetweenFloorDown) or (Join2.FConnRaiseType = crt_TrunkUp) or (Join2.FConnRaiseType = crt_TrunkDown) then
begin
vList := GetListByID(Join2.FID_ListToPassage);
if vList <> nil then
if CheckNoCadInList(vList, Result) then
Result.Add(vList);
end
else
// íà ýòîì êîííåêòîðå åñòü âåðøèíà ìåæýòàæíîãî
if aCheckBySelectedType = cst_Move then
begin
RaiseConn := GetRaiseConn(Join2);
if RaiseConn <> nil then
if (RaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (RaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (RaiseConn.FConnRaiseType = crt_TrunkUp) or (RaiseConn.FConnRaiseType = crt_TrunkDown) then
begin
vList := GetListByID(RaiseConn.FID_ListToPassage);
if vList <> nil then
if CheckNoCadInList(vList, Result) then
Result.Add(vList);
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.GetRelatedListsBySelected', E.Message);
end;
end;
function CheckOneOfSCSlayers(aLNbr: Integer): Boolean;
begin
Result := False;
try
if aLNbr = 2 then
Result := True;
if aLNbr = 3 then
Result := True;
if aLNbr = 4 then
Result := True;
if aLNbr = 5 then
Result := True;
if aLNbr = 6 then
Result := True;
if aLNbr = 9 then
Result := True;
except
on E: Exception do addExceptionToLogEx('U_Common.CheckOneOfSCSlayers', E.Message);
end;
end;
procedure DeselectAllSCSObjectsInCAD(AListID: Integer);
var
vList: TF_CAD;
begin
try
vList := GetListByID(AListID);
if vList <> nil then
begin
vList.PCad.DeselectAll(2);
RefreshCAD(vList.PCad);
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.DeselectAllSCSObjectsInCAD', E.Message);
end;
end;
procedure DeselectAllSCSObjectsInProject;
var
i: integer;
CAD: TF_CAD;
begin
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
CAD := TF_CAD(FSCS_Main.MDIChildren[i]);
if CAD.FListType = lt_Normal then
begin
CAD.PCad.DeselectAll(2);
RefreshCAD(CAD.PCad);
end;
end;
end;
procedure DeselectNoDrawed(aPCAD: TPowerCad);
var
i: Integer;
Figure: TFigure;
begin
for i := 0 to aPCAD.Figures.Count - 1 do
begin
Figure := TFigure(aPCAD.Figures[i]);
if Figure is TConnectorObject then
if Not TConnectorObject(Figure).FIsDraw and TConnectorObject(Figure).Selected then
TConnectorObject(Figure).DeSelect;
end;
end;
procedure SelectObjectsInCADByIDs(aListID: Integer; aObjectsID: TIntList);
var
i: Integer;
ID: Integer;
vList: TF_CAD;
vFigure: TFigure;
begin
try
vList := GetListByID(aListID);
if vList <> nil then
begin
for i := 0 to aObjectsID.Count - 1 do
begin
ID := aObjectsID[i];
vFigure := GetFigureByID(vList, ID);
if vFigure <> nil then
begin
if Not GCanRefreshProperties then
if (not vFigure.LockSelect) and (vList.PCad.ActiveLayer = 2) then
GCanRefreshProperties := True;
vFigure.Select;
end;
end;
RefreshCAD(vList.PCad);
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.SelectObjectsInCADByIDs', E.Message);
end;
end;
function GetObjectsListWithSelectedInCAD(aListID: Integer): TIntList;
var
i: Integer;
vFigure: TFigure;
vList: TF_CAD;
begin
Result := TIntList.create;
try
vList := GetListByID(aListID);
if vList <> nil then
begin
for i := 0 to vList.PCad.SelectedCount - 1 do
begin
vFigure := TFigure(vList.PCad.Selection[i]);
Result.Add(vFigure.ID);
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.GetObjectsListWithSelectedInCAD', E.Message);
end;
end;
function Get_News(ParentWin : THandle; gpid, gURL_p, gURL_a, gfil : string; func : byte; var timr :word): byte;
var
ActHandle : THandle;//õýíäë àêòèâíîãî ïðèëîæåíèÿ
GetNews : procedure(hndl : THandle; pid, URL_p, URL_a, fil : string; alarm, draw, autosave : boolean); stdcall;
OpenNews : procedure(hndl : THandle; pid, URL_p, URL_a, fil : string); stdcall;
GetInt : function(hndl : THandle; pid, URL_p, URL_a, fil : string):word; stdcall;
begin
Result:=0;
(*
if Newshandle = 0 then
Newshandle := LoadLibrary(PChar('exnews.dll'));
try
if Newshandle<>0 then
begin
case func of
0:begin//ïðîâåðêà íàëè÷èÿ íîâîñòåé
@GetNews:=GetProcAddress(Newshandle,'GetNews');
if @GetNews<>nil then
begin
try
ActHandle:=GetForegroundWindow;
GetNews(ParentWin, gpid, gURL_p, gURL_a, gfil,false, false, true);
SetForegroundWindow(ActHandle);//÷òîáû íå çàáèðàòü ôîêóñ ó àêòèâíîãî îêíà!
except
Result:=4;// 4 - Îøèáêà âûïîëíåíèÿ ïðîöåäóðû
Exit;
end;
end
else
begin
Result:=2;// 2 - Îøèáêà âûçîâà ïðîöåäóðû
Exit;
end;
end;{1}
1:begin{2}
//îòêðûòèå ôîðìû äëÿ ðàáîòû ñ íîâîñòÿìè
@OpenNews:=GetProcAddress(Newshandle,'Execute');
if @OpenNews<>nil then
begin{a}
try
OpenNews(ParentWin, gpid, gURL_p, gURL_a, gfil)
except
Result:=4;// 4 - Îøèáêà âûïîëíåíèÿ ïðîöåäóðû
Exit;
end;{except}
end{a}
else
begin
Result:=2;// 2 - Îøèáêà âûçîâà ïðîöåäóðû
Exit;
end;
end;{2}
2:begin{3}
//îòêðûòèå ôîðìû äëÿ ðàáîòû ñ íîâîñòÿìè
@GetInt:=GetProcAddress(Newshandle,'GetInterval');
if @GetInt<>nil then
begin{a}
try
timr:=GetInt(ParentWin, gpid, gURL_p, gURL_a, gfil)
except
Result:=4;// 4 - Îøèáêà âûïîëíåíèÿ ïðîöåäóðû
Exit;
end;{except}
end{a}
else
begin
Result:=2;// 2 - Îøèáêà âûçîâà ïðîöåäóðû
Exit;
end;
end;{3}
else
begin
Result:=3;// 3 - îøèáî÷íûé ïàðàìåòð func
Exit;
end;
end;
end
else
begin
Result:=1;// 1 - îøèáêà çàãðóçêè DLL,
Exit;
end;
finally
// if FreeLibrary(Newshandle) then
// Newshandle:=0;
end;
*)
end;
//Tolik
function GetRoomSquare(AListID, ARoomID: Integer; RecalcSquare:Boolean = False): Double;
var
vList: TF_CAD;
Cabinet: TFigure;
x1, x2, y1, y2: double;
a, b, S: double;
MaxX, MaxY, MinX, MinY: Double;
i, j: Integer;
sum1, sum2, resultsum: double;
Segment: TPlSegment;
begin
Result := -1;
try
vList := GetListByID(AListID);
Cabinet := nil; //#From Oleg# //14.09.2010
if vList <> nil then
Cabinet := FindCabinetBySCSID(vList, ARoomID);
if Cabinet <> nil then
begin
// Äëÿ ïðîñòûõ êàáèíåòîâ
if CheckFigureByClassName(Cabinet, cTCabinet) then
begin
if (RecalcSquare or (TCabinet(Cabinet).FCabinetSquare = -1)) then
begin
for i := 1 to Cabinet.PointCount - 1 do
begin
x1 := Cabinet.FigurePoints[i].x;
y1 := Cabinet.FigurePoints[i].y;
x2 := Cabinet.FigurePoints[i+1].x;
y2 := Cabinet.FigurePoints[i+1].y;
//S := S + ((y2+y1)/2) * ((x2-x1)/2);
sum1 := sum1 + x1*y2;
sum2 := sum2 + y1*x2;
end;
x1 := Cabinet.FigurePoints[TCabinetExt(Cabinet).PointCount].x;
y1 := Cabinet.FigurePoints[TCabinetExt(Cabinet).PointCount].y;
x2 := Cabinet.FigurePoints[1].x;
y2 := Cabinet.FigurePoints[1].y;
//S := S + ((y2+y1)/2) * ((x2-x1)/2);
sum1 := sum1 + x1*y2;
sum2 := sum2 + y1*x2;
Result := RoundX(ABS(sum2 - sum1)/2, 2);
if RecalcSquare then
TCabinet(Cabinet).FCabinetSquare := -1;
end
else
Result := TCabinet(Cabinet).FCabinetSquare;
end
else if CheckFigureByClassName(Cabinet, cTCabinetExt) then
begin
// !!!
if (RecalcSquare or (TCabinetExt(Cabinet).FCabinetSquare = -1)) then
begin
S := 0;
TCabinetExt(Cabinet).getbounds(MaxX, MaxY, MinX, MinY);
for i := round(MinX) to round(MaxX) do
begin
for j := round(MinY) to round(MaxY) do
begin
if TCabinetExt(Cabinet).IsPointInMod(i, j) then
S := S + 1;
end;
end;
S := SQR(vList.PCad.MapScale / 1000) * S;
Result := S;
if RecalcSquare then
TCabinetExt(Cabinet).FCabinetSquare := -1;
{
for i := 0 to TCabinetExt(Cabinet).Segments.Count - 1 do
begin
Segment:= TPlSegment(TCabinetExt(Cabinet).Segments);
x1 := Segment.CPoint1.x;
y1 := Segment.CPoint1.y;
end;}
// Tolik
{
TCabinetExt(Cabinet).getbounds(MaxX, MaxY, MinX, MinY);
s := 0;
sum1 := 0;
sum2 := 0;
ResultSum := 0;
for i := 0 to TCabinetExt(Cabinet).Segments.Count - 1 do
begin
Segment:= TPlSegment(TCabinetExt(Cabinet).Segments);
x1 := Segment.CPoint1.x;
end;
for i := 1 to TCabinetExt(Cabinet).PointCount - 1 do
begin
x1 := TCabinetExt(Cabinet).FigurePoints[i].x/10;
y1 := TCabinetExt(Cabinet).FigurePoints[i].y/10;
x2 := TCabinetExt(Cabinet).FigurePoints[i+1].x/10;
y2 := TCabinetExt(Cabinet).FigurePoints[i+1].y/10;
S := S + ((y2+y1)/2) * ((x2-x1)/2);
sum1 := sum1 + x1*y2;
sum2 := sum2 + y1*x2;
end;
x1 := TCabinetExt(Cabinet).FigurePoints[TCabinetExt(Cabinet).PointCount].x/10;
y1 := TCabinetExt(Cabinet).FigurePoints[TCabinetExt(Cabinet).PointCount].y/10;
x2 := TCabinetExt(Cabinet).FigurePoints[1].x/10;
y2 := TCabinetExt(Cabinet).FigurePoints[1].y/10;
S := S + ((y2+y1)/2) * ((x2-x1)/2);
sum1 := sum1 + x1*y2;
sum2 := sum2 + y1*x2;
Result := RoundX(ABS(sum2 - sum1)/2, 2);
}
end
else
Result := TCabinetExt(Cabinet).FCabinetSquare;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.GetRoomSquare', E.Message);
end;
end;
{
function GetRoomSquare(AListID, ARoomID: Integer): Double;
var
vList: TF_CAD;
Cabinet: TFigure;
x1, x2, y1, y2: double;
a, b, S: double;
MaxX, MaxY, MinX, MinY: Double;
i, j: Integer;
begin
Result := -1;
try
vList := GetListByID(AListID);
Cabinet := nil; //#From Oleg# //14.09.2010
if vList <> nil then
Cabinet := FindCabinetBySCSID(vList, ARoomID);
if Cabinet <> nil then
begin
if CheckFigureByClassName(Cabinet, cTCabinet) then
begin
x1 := Cabinet.ap1.x;
y1 := Cabinet.ap1.y;
x2 := Cabinet.ap3.x;
y2 := Cabinet.ap3.y;
a := abs(x2 - x1);
a := a * vList.PCad.MapScale / 1000;
b := abs(y2 - y1);
b := b * vList.PCad.MapScale / 1000;
S := a * b;
Result := S;
end
else if CheckFigureByClassName(Cabinet, cTCabinetExt) then
begin
// !!!
S := 0;
TCabinetExt(Cabinet).getbounds(MaxX, MaxY, MinX, MinY);
for i := round(MinX) to round(MaxX) do
begin
for j := round(MinY) to round(MaxY) do
begin
if TCabinetExt(Cabinet).IsPointInMod(i, j) then
S := S + 1;
end;
end;
S := SQR(vList.PCad.MapScale / 1000) * S;
Result := S;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.GetRoomSquare', E.Message);
end;
end;
}
//Tolik
// function GetRoomVolume(AListID, ARoomID: Integer ): Double;
function GetRoomVolume(AListID, ARoomID: Integer; ARoomSquare: Double): Double;
var
x1, x2, y1, y2: double;
S, V: double;
begin
Result := 0;
try
//S := GetRoomSquare(AListID, ARoomID);
//V := S * GCadForm.FRoomHeight;
V := ARoomSquare * GCadForm.FRoomHeight;
Result := V;
except
on E: Exception do AddExceptionToLogEx('U_Common.GetRoomVolume', E.Message);
end;
end;
procedure CreateVirtualCabinetInCAD(vList: TF_CAD);
var
Cabinet: TCabinet;
Lhandle: Integer;
x1, y1, x2, y2: double;
begin
try
if vList <> nil then
begin
x1 := vList.PCad.Left;
x2 := vList.PCad.Left + vList.PCad.WorkWidth;
y1 := vList.PCad.Top;
y2 := vList.PCad.Top + vList.PCad.WorkHeight;
LHandle := vList.PCad.GetLayerHandle(9);
Cabinet := TCabinet.create(x1, y1, x2, y2, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, vList.PCad);
vList.PCad.AddCustomFigure(9, Cabinet, False);
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.CreateVirtualCabinetInCAD', E.Message);
end;
end;
procedure ReScaleDrawingToListFormat(aOldListW, aOldListH: double);
var
ListFormat: TListFormatType;
Grp: TSCSFigureGrp;
rp: TDoublePoint;
i: Integer;
Cabinet: TCabinet;
CabinetExt: TCabinetExt;
SCSFigureGrp: TSCSFigureGrp;
cp: TDoublePoint;
BoundRect: TDoubleRect;
koefx, koefy: double;
deltax, deltay: double;
oldsizex, oldsizey, newsizex, newsizey: double;
NewListW, NewListH: double;
Figure: TFigure;
begin
try
BeginProgress;
NewListW := GCadForm.PCad.WorkWidth;
NewListH := GCadForm.PCad.WorkHeight;
GCadForm.PCad.SelectAll(1);
GCadForm.PCad.SelectAll(2);
GCadForm.PCad.SelectAll(8);
GCadForm.PCad.SelectAll(9);
BoundRect := GCadForm.PCad.GetSelectionRect;
GCadForm.PCad.DeselectAll(0);
rp := DoublePoint(BoundRect.Left, BoundRect.Top);
// 1 - ïîäëîæêà
GCadForm.PCad.SelectAll(1);
oldsizex := abs(BoundRect.Right - BoundRect.Left);
oldsizey := abs(BoundRect.Bottom - BoundRect.Top);
deltax := aOldListW - oldsizex;
newsizex := NewListW - deltax;
koefx := newsizex / oldsizex;
deltay := aOldListH - oldsizey;
newsizey := NewListH - deltay;
koefy := newsizey / oldsizey;
GCadForm.PCad.ScaleSelection(koefx, koefy, rp);
GCadForm.PCad.DeSelectAll(1);
// (2-6) ÑÊÑ
GCadForm.PCad.SelectAll(2);
Grp := SCSGroupSelection;
if Grp <> nil then
begin
Grp.Scale(koefx, koefy, rp);
Grp.UnGroup;
GCadForm.PCad.Figures.Remove(Grp);
end;
GCadForm.PCad.DeSelectAll(2);
// îòäåëüíî Scale äëÿ TSCSFigureGrp
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTSCSFigureGrp) then
begin
SCSFigureGrp := TSCSFigureGrp(GCadForm.PCad.Figures[i]);
SCSFigureGrp.Scale(koefx, koefy, rp);
end;
end;
//Çàëî÷èë,ïîòîìó ÷òî íèæå äàííûé ActiveNet ïåðåñ÷èòûâàåòñÿ åù¸ ðàç
{ // 8 - àðõèòåêòóðíûé
if ActiveNet <> nil then
ActiveNet.Scale(koefx, koefy, rp); }
// 9 - êàáèíåòû
for i := 0 to GCadForm.Pcad.FigureCount - 1 do
begin
Figure := TFigure(GCadForm.Pcad.Figures[i]);
if Figure is TCabinet then
begin
Cabinet := TCabinet(Figure);
Cabinet.Scale(koefx, koefy, rp);
if Cabinet.FNumberObject <> nil then
begin
cp.x := (Cabinet.ActualPoints[1].x + Cabinet.ActualPoints[3].x) / 2;
cp.y := (Cabinet.ActualPoints[1].y + Cabinet.ActualPoints[3].y) / 2;
Cabinet.FNumberObject.move(CP.x - Cabinet.FNumberObject.CenterPoint.x, CP.y - Cabinet.FNumberObject.CenterPoint.y);
end;
MoveObjectsToCabinetOnMove(Cabinet);
end
else if Figure is TCabinetExt then
begin
CabinetExt := TCabinetExt(Figure);
CabinetExt.Scale(koefx, koefy, rp);
CabinetExt.CenterNumberObject;
end
// Åñëè àðõ. îáúåêò
else if Figure is TNet then
begin
TNet(Figure).Scale(koefx, koefy, rp);
end;
end;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do AddExceptionToLogEx('U_Common.ReScaleDrawingToListFormat', E.Message);
end;
EndProgress;
end;
procedure DeleteDxfLayers(aPCad: TPowerCad);
var
i: integer;
vLayer: TLayer;
vLNbr: Integer;
vList: TList;
begin
try
BeginProgress;
vList := TList.Create;
for i := 10 to aPcad.Layers.count - 1 do
begin
vLayer := TLayer(aPcad.Layers[i]);
if vLayer.isDxf then
vList.add(vLayer);
end;
for i := 0 to vList.Count - 1 do
begin
vLayer := TLayer(vList[i]);
vLNbr := aPCad.GetLayerNbr(vLayer);
aPCad.DeleteLayerWithNbr(vLNbr);
end;
FreeAndNil(vList);
except
on E: Exception do AddExceptionToLogEx('U_Common.DeleteDxfLayers', E.Message);
end;
EndProgress;
end;
function CheckFigureInDXFLayer(aFigure: TFigure): Boolean;
var
i: integer;
Layer: Tlayer;
fLNbr: integer;
begin
Result := false;
try
for i := 10 to GCadForm.PCad.LayerCount - 1 do
begin
Layer := TLayer(GCadForm.PCad.Layers[i]);
if Layer.IsDxf then
begin
if (aFigure.LayerHandle = LongInt(Layer)) then
Result := true;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.CheckFigureInDXFLayer', E.Message);
end;
end;
procedure ApplyUOMForProject(aOldUOM, aNewUOM: Integer);
var
i: Integer;
vList: TF_CAD;
vLists: TList;
begin
try
// *UNDO*
// vLists := TList.Create;
// for i := 0 to FSCS_Main.MDIChildCount - 1 do
// begin
// vList := TF_CAD(FSCS_Main.MDIChildren[i]);
// vLists.add(vList);
// end;
// SaveForProjectUndo(vLists, True, False);
//
// ìåòðè÷åñêàÿ
if (aNewUOM = umSM) or (aNewUOM = umM) then
begin
// áûëà àìåðèêàíñêàÿ, ïîñòàâèòü íà âñå ëèñòû ìåòðè÷åñêóþ
if (aOldUOM = umIn) or (aOldUOM = umFt) then
begin
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
vList := TF_CAD(FSCS_Main.MDIChildren[i]);
vList.PCad.RulerSystem := rsMetric;
end;
end;
end
else
// àìåðèêàíñêàÿ
if (aNewUOM = umIn) or (aNewUOM = umFt) then
begin
// áûëà ìåòðè÷åñêàÿ, ïîñòàâèòü íà âñå ëèñòû àìåðèêàíñêóþ
if (aOldUOM = umSM) or (aOldUOM = umM) then
begin
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
vList := TF_CAD(FSCS_Main.MDIChildren[i]);
vList.PCad.RulerSystem := rsWhitworth;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.ApplyUOMForProject', E.Message);
end;
end;
function GetUOMString(aUOM: Integer): string;
begin
try
Result := ' ';
if aUOM = umSM then
Result := Result + cMetric_sm;
if aUOM = umM then
Result := Result + cMetric_m;
if aUOM = umIn then
Result := Result + cWhitworth_in;
if aUOM = umFt then
Result := Result + cWhitworth_ft;
except
on E: Exception do AddExceptionToLogEx('U_Common.GetUOMString', E.Message);
end;
end;
// ïåðåâåñòè ìåòðû â òåêóùóþ ñèñòåìó èçìåðåíèé
function MetreToUOM(aValue: Double): Double;
begin
Result := 0;
try
Result := FloatInUOM(AValue, umM, GCurrProjUnitOfMeasure);
except
on E: Exception do AddExceptionToLogEx('U_Common.MetreToUOM', E.Message);
end;
end;
// ïåðåâåñòè òåêóùóþ ñèñòåìó èçìåðåíèé â ìåòðû
function UOMToMetre(aValue: Double): Double;
begin
Result := 0;
try
Result := FloatInUOM(AValue, GCurrProjUnitOfMeasure, umM);
except
on E: Exception do AddExceptionToLogEx('U_Common.UOMToMetre', E.Message);
end;
end;
procedure UpdateAllTracesLengthAndRefreshTextBoxOnAllLists;
var
i, j: Integer;
vList: TF_CAD;
vLine: TOrtholine;
SavedGCadForm: TF_CAD;
begin
try
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
vList := TF_CAD(FSCS_Main.MDIChildren[i]);
if vList.FListType = lt_Normal then
begin
for j := 0 to vList.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(vLIst.PCad.Figures[j]), cTOrthoLine) then
begin
SavedGCadForm := GCadForm;
GCadForm := vList;
vLine := TOrthoLine(vLIst.PCad.Figures[j]);
vLine.UpdateLengthTextBox(true, false);
vLine.ReCreateNotesGroup(True);
SetConFigureCoordZInPM(vLine.JoinConnector1.ID, vLine.ActualZOrder[1]);
SetConFigureCoordZInPM(vLine.JoinConnector2.ID, vLine.ActualZOrder[2]);
GCadForm := SavedGCadForm;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('UpdateAllTracesLengthOnAllLists', E.Message);
end;
end;
procedure UpdateAllTracesLengthOnAllLists;
var
i, j: Integer;
vList: TF_CAD;
vLine: TOrtholine;
SavedGCadForm: TF_CAD;
begin
try
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
vList := TF_CAD(FSCS_Main.MDIChildren[i]);
if vList.FListType = lt_Normal then
begin
for j := 0 to vList.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(vLIst.PCad.Figures[j]), cTOrthoLine) then
begin
SavedGCadForm := GCadForm;
GCadForm := vList;
vLine := TOrthoLine(vLIst.PCad.Figures[j]);
vLine.UpdateLengthTextBox(true, false);
GCadForm := SavedGCadForm;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('UpdateAllTracesLengthOnAllLists', E.Message);
end;
end;
function CadsToIntCads(aList: TList): TIntList;
var
i: Integer;
ID: Integer;
begin
Result := TIntList.Create;
try
for i := 0 to aList.Count - 1 do
begin
ID := TF_CAD(aList[i]).FCADListID;
Result.Add(ID);
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.CadsToIntCads', E.Message);
end;
end;
function IntCadsToCads(aIntList: TIntList): TList;
var
i: Integer;
ID: Integer;
Cad: TF_CAD;
begin
Result := TList.Create;
try
for i := 0 to aIntList.Count - 1 do
begin
ID := aIntList[i];
Cad := GetListByID(ID);
Result.Add(Cad);
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.IntCadsToCads', E.Message);
end;
end;
function FiguresToIntFigures(aList: TList): TIntList;
var
i: Integer;
ID: Integer;
begin
Result := TIntList.Create;
try
for i := 0 to aList.Count - 1 do
begin
ID := TFigure(aList[i]).ID;
Result.Add(ID);
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.FiguresToIntFigures', E.Message);
end;
end;
function IntFiguresToFigures(aIntList: TIntList): TList;
var
i: Integer;
ID: Integer;
Figure: TFigure;
begin
Result := TList.Create;
try
for i := 0 to aIntList.Count - 1 do
begin
ID := aIntList[i];
Figure := GetFigureByID(GCadForm, ID);
Result.Add(Figure);
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.IntFiguresToFigures', E.Message);
end;
end;
function CheckExistBetweenFloorOnList(aCad: TF_CAD): Boolean;
var
i: integer;
figure: Tfigure;
begin
Result := False;
try
for i := 0 to aCad.PCad.FigureCount - 1 do
begin
figure := TFigure(aCad.PCad.Figures[i]);
if CheckFigureByClassName(figure, cTConnectorObject) then
if (TConnectorObject(figure).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(figure).FConnRaiseType = crt_BetweenFloorDown) or
(TConnectorObject(figure).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(figure).FConnRaiseType = crt_TrunkDown) then
begin
Result := True;
Break;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.CheckExistBetweenFloorOnList', E.Message);
end;
end;
function CheckTTextExistForDXF(aBlock: TBlock): Boolean;
var
i: integer;
InFigure: TFigure;
begin
Result := false;
try
for i := 0 to aBlock.InFigures.Count - 1 do
begin
InFigure := TFigure(aBlock.InFigures[i]);
if InFigure.ClassName = 'TText' then
begin
Result := true;
break;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.CheckTTextExistForDXF', E.Message);
end;
end;
procedure ConvertBMPToJpeg(aBmp: TBitmap; aFileName: string);
var
Jpeg: TJPEGImage;
begin
try
Jpeg := TJpegImage.Create;
Jpeg.Assign(aBmp);
JPeg.SaveToFile(ChangeFileExt(aFileName, '.jpg'));
FreeAndNil(Jpeg);
except
on E: Exception do AddExceptionToLogEx('U_Common.ConvertBMPToJpeg', E.Message);
end;
end;
procedure SaveSubstrateArchPlan(aFileName: string);
var
Bmp: TBitmap;
Jpeg: TJPEGImage;
ExtStr: string;
BmpFileName: string;
begin
try
ExtStr := ExtractFileExt(aFileName);
if ExtStr = '.bmp' then
begin
GCadForm.PCad.SaveSubstrateAsBitmap(aFileName);
end
else
if (ExtStr = '.jpg') then
begin
BmpFileName := ChangeFileExt(aFileName, '.bmp');
GCadForm.PCad.SaveSubstrateAsBitmap(BmpFileName);
Bmp := TBitmap.Create;
Bmp.LoadFromFile(BmpFileName);
ConvertBMPToJpeg(Bmp, aFileName);
FreeAndNil(Bmp);
DeleteFile(BmpFileName);
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.GetSubstrateArchPlanBitmap', E.Message);
end;
end;
procedure DeleteHouseOnCAD(aListID, AObjectID: Integer);
var
vHouse: THouse;
vList: TF_CAD;
vFigure: TFigure;
begin
try
// Íåëüçÿ çäåñü - èíà÷å íà ÊÀÄå íà òîì ÷òî íóæíî óäàëèòñÿ, à âîò ñ ÏÌ - íå ñ òîãî
// òàêàÿ ïðîâåðêà - â procedure TF_MAIN.DelCompon(AComponent: TSCSComponent; ANode: TTreeNode;
//if aListID <> GCadForm.FCADListID then
// aListID := GCadForm.FCADListID;
// à ÷òî áû èñêëþ÷èòü çàâèñàíèå ÊÀÄà ëó÷øå íàâåðíîå òàê ñäåëàåì:
if aListID <> GCadForm.FCADListID then
exit;
vList := GetListByID(aListID);
if (vList <> nil) then
begin
vFigure := GetHouseByID(vList, AObjectID);
if vFigure <> nil then
begin
if CheckFigureByClassName(vFigure, cTHouse) then
begin
THouse(vFigure).Delete;
RefreshCAD(vList.PCad);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('U_Common.DeleteHouseOnCAD', E.Message);
end;
end;
procedure DeleteApproachOnCAD(aListID, aHouseID, AComponID: Integer);
var
vList: TF_CAD;
House: THouse;
Approach: TConnectorObject;
begin
try
if aListID <> GCadForm.FCADListID then
exit;
vList := GetListByID(aListID);
if vList <> nil then
begin
Approach := GetApproachByComponID(vList, AComponID);
if Approach <> nil then
begin
Approach.Delete(False, False);
RefreshCAD(vList.PCad);
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.DeleteApproachOnCAD', E.Message);
end;
end;
procedure SnapConnectorToHouse(aConnector: TConnectorObject; aSnapHouse: THouse);
var
i: Integer;
pt: TDoublePoint;
SegIndex: Integer;
begin
try
pt := aConnector.ActualPoints[1];
SegIndex := -1;
For i := 1 to aSnapHouse.PointCount do
begin
if aSnapHouse.IsPointInSegment(i, pt.x, pt.y) then
begin
SegIndex := i;
break;
end;
end;
if SegIndex = - 1 then
exit;
aSnapHouse.InsertKnot(SegIndex, pt);
aConnector.FIsHouseJoined := True;
aConnector.FHouse := aSnapHouse;
aSnapHouse.fJoined.Add(aConnector);
except
on E: Exception do AddExceptionToLogEx('U_Common.SnapConnectorToHouse', E.Message);
end;
end;
function GetIDElementFromComplexObjByTrace(AID_List, AIDComplexFigure, AIDTrace: Integer): Integer;
var
vHouse: THouse;
vLine: TOrthoLine;
Join1, Join2: TConnectorObject;
vList: TF_CAD;
begin
Result := -1;
try
//íà âûõîäå:
//ID ýëåìåíòà êîìïëåêñíîãî îáúåêòà(ïîäúåçäà), èëè
//0 - òðàññà ïîäêëþ÷åíà ê êîìïëåêñíîìó îáúåêòó(òîåñòü äîìó)
//-1 - òðàññà íè ÷åì íå ñâÿçàíà ñ äîìîì
vList := GetListByID(AID_List);
if vList = nil then
exit;
vHouse := GetHouseByID(vList, AIDComplexFigure);
vLine := TOrthoLine(GetFigureByID(vList, AIDTrace));
if (vHouse = nil) or (vLine = nil) then
exit;
Join1 := TConnectorObject(vLine.JoinConnector1);
Join2 := TConnectorObject(vLine.JoinConnector2);
if Join1.FIsHouseJoined then
if Join1.FHouse <> nil then
if Join1.FHouse = vHouse then
begin
Result := 0;
exit;
end;
if Join2.FIsHouseJoined then
if Join2.FHouse <> nil then
if Join2.FHouse = vHouse then
begin
Result := 0;
exit;
end;
if Join1.JoinedConnectorsList.Count > 0 then
if TConnectorObject(Join1.JoinedConnectorsList[0]).FIsApproach then
if TConnectorObject(Join1.JoinedConnectorsList[0]).FHouse = vHouse then
Result := TConnectorObject(Join1.JoinedConnectorsList[0]).FComponID;
if Join2.JoinedConnectorsList.Count > 0 then
if TConnectorObject(Join2.JoinedConnectorsList[0]).FIsApproach then
if TConnectorObject(Join2.JoinedConnectorsList[0]).FHouse = vHouse then
Result := TConnectorObject(Join2.JoinedConnectorsList[0]).FComponID;
except
on E: Exception do AddExceptionToLogEx('U_Common.GetIDElementFromComplexObjByTrace', E.Message);
end;
end;
function GetConnectedTracesToConnetorByID(AIDList, AIDConnectorFigure: Integer): TIntList;
var
CADList: TF_CAD;
vFigure: TFigure;
ConnectorFigure: TConnectorObject;
JoinedConnector: TConnectorObject;
Approach: TConnectorObject;
House: THouse;
i, j, k: Integer;
begin
Result := TIntList.Create;
ConnectorFigure := nil;
CADList := GetListByID(AIDList);
if CADList <> nil then
begin
vFigure := GetFigureByID(CADList, AIDConnectorFigure);
if vFigure = nil then
vFigure := GetHouseByID(CADList, AIDConnectorFigure);
if vFigure <> nil then
begin
// CONNECTOR
if CheckFigureByClassName(vFigure, cTConnectorObject) then
begin
ConnectorFigure := TConnectorObject(vFigure);
// òðàññû ïðèñîåäèíåíû íàïðÿìóþ
if ConnectorFigure.JoinedConnectorsList.Count = 0 then
begin
for i := 0 to ConnectorFigure.JoinedOrtholinesList.Count - 1 do
Result.Add(TOrthoLine(ConnectorFigure.JoinedOrtholinesList[i]).ID);
end
else
// ×åðåç òî÷. îáúåêòû
for i := 0 to ConnectorFigure.JoinedConnectorsList.Count - 1 do
begin
JoinedConnector := TConnectorObject(ConnectorFigure.JoinedConnectorsList[i]);
for j := 0 to JoinedConnector.JoinedOrtholinesList.Count - 1 do
Result.Add(TOrthoLine(JoinedConnector.JoinedOrtholinesList[j]).ID);
end;
end
// HOUSE
else if CheckFigureByClassName(vFigure, cTHouse) then
begin
House := THouse(vFigure);
// ïåðåáðàòü ñâÿçóþùèå êîííåêòîðû
for i := 0 to House.fJoined.Count - 1 do
begin
JoinedConnector := TConnectorObject(House.fJoined[i]);
for j := 0 to JoinedConnector.JoinedOrtholinesList.Count - 1 do
Result.Add(TOrthoLine(JoinedConnector.JoinedOrtholinesList[j]).ID);
end;
// ïåðåáðàòü ïîäúåçäû
for i := 0 to House.fApproaches.Count - 1 do
begin
Approach := TConnectorObject(House.fApproaches[i]);
for j := 0 to Approach.JoinedConnectorsList.Count - 1 do
begin
JoinedConnector := TConnectorObject(Approach.JoinedConnectorsList[j]);
for k := 0 to JoinedConnector.JoinedOrtholinesList.Count - 1 do
Result.Add(TOrthoLine(JoinedConnector.JoinedOrtholinesList[k]).ID);
end;
end;
end;
end;
end;
end;
function GetConnectedFigures(AFigure: TFigure; AClearConnToRes: Boolean=false; ASkipList: TList=nil): TList; //#From Oleg# //15.09.2010
var
i, j: Integer;
JoinedConnObject: TConnectorObject;
//ListOfPassage: TF_CAD;
//ConnOfPassage: TConnectorObject;
//ConnectedObjectsFromBetweenFloorConnector: TRapList;
JoinedLine: TOrtholine;
JoinedConnector: TConnectorObject;
FigureToResult: TFigure;
procedure AddFigureToResult(AFigureToRes: TFigure);
begin
if (ASkipList = nil) or (ASkipList.IndexOf(AFigureToRes) = -1) then
Result.Add(AFigureToRes);
end;
//*** Âåðíåò ïîäêëþ÷åííûå îáúåêòû (íà äðóãîì ëèñòå) ê ñîåäèíèòåëþ, ÷òî ïîäêëþ÷åí ê ü-ý ïåðåõîäó
function GetConnectedObjectsFromBetweenFloorConnector(AConnObject: TConnectorObject): TRapList;
var
IndexFigure: Integer;
ConnectedFigures: TRapList;
ListOfPassage: TF_CAD;
ConnOfPassage: TConnectorObject;
i: Integer;
begin
Result := nil;
ListOfPassage := GetListOfPassage(AConnObject.FID_ListToPassage);
if ListOfPassage <> nil then
begin
ConnOfPassage := TConnectorObject(GetFigureByID(ListOfPassage, AConnObject.FID_ConnToPassage));
if ConnOfPassage <> nil then
begin
ConnectedFigures := TRapList.Create;
for i := 0 to ConnOfPassage.JoinedOrtholinesList.Count - 1 do
ConnectedFigures.Add(TOrthoLine(ConnOfPassage.JoinedOrtholinesList.List^[i]));
Result := ConnectedFigures;
end;
end;
end;
procedure GetObjectsFromOrtholineConnector(AConnector: TConnectorObject);
var
ConnRaiseType: TConnRaiseType;
//ConnObject: TConnectorObject;
FigureToResult: TFigure;
i: integer;
ConnectedObjectsFromBetweenFloorConnector: TRapList;
begin
if AClearConnToRes then
begin
if AConnector.JoinedConnectorsList.Count = 0 then
AddFigureToResult(AConnector)
else
for i := 0 to AConnector.JoinedConnectorsList.Count - 1 do
begin
FigureToResult := TConnectorObject(AConnector.JoinedConnectorsList.List^[i]);
AddFigureToResult(FigureToResult); //Result.Add(FigureToResult);
end;
end
else
begin
ConnRaiseType := AConnector.FConnRaiseType;
if (ConnRaiseType = crt_BetweenFloorUp) or (ConnRaiseType = crt_BetweenFloorDown) then
begin
ConnectedObjectsFromBetweenFloorConnector := GetConnectedObjectsFromBetweenFloorConnector(AConnector);
if ConnectedObjectsFromBetweenFloorConnector <> nil then
begin
for i := 0 to ConnectedObjectsFromBetweenFloorConnector.Count - 1 do
begin
FigureToResult := TFigure(ConnectedObjectsFromBetweenFloorConnector.List^[i]);
if FigureToResult is TOrtholine then
AddFigureToResult(FigureToResult);//Result.Add(FigureToResult);
end;
ConnectedObjectsFromBetweenFloorConnector.Free;
end;
end
else
begin
for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList.List^[i]);
if JoinedLine <> TOrthoLine(AFigure) then
AddFigureToResult(JoinedLine); //Result.Add(JoinedLine);
end;
for i := 0 to AConnector.JoinedConnectorsList.Count - 1 do
begin
FigureToResult := TConnectorObject(AConnector.JoinedConnectorsList.List^[i]);
AddFigureToResult(FigureToResult); //Result.Add(FigureToResult);
end;
end;
end;
end;
begin
Result := TList.Create;
if AFigure is TConnectorObject then
begin
if TConnectorObject(AFigure).ConnectorType = ct_Clear then
begin
for i := 0 to TConnectorObject(AFigure).JoinedOrtholinesList.Count - 1 do
begin
FigureToResult := TOrthoLine(TConnectorObject(AFigure).JoinedOrtholinesList.List^[i]);
AddFigureToResult(FigureToResult);//Result.Add(FigureToResult);
end;
end
else
for i := 0 to TConnectorObject(AFigure).JoinedConnectorsList.Count - 1 do
begin
JoinedConnObject := TConnectorObject(TConnectorObject(AFigure).JoinedConnectorsList.List^[i]);
for j := 0 to JoinedConnObject.JoinedOrtholinesList.Count - 1 do
begin
FigureToResult := TOrthoLine(JoinedConnObject.JoinedOrtholinesList.List^[j]);
AddFigureToResult(FigureToResult); //Result.Add(FigureToResult);
end;
end;
end
else
if AFigure is TOrthoLine then
begin
// Ñòîðîíà 1
//ConnObject := TConnectorObject(TOrthoLine(AFigure).JoinConnector1);
//ConnRaiseType := ConnObject.FConnRaiseType;
//if (ConnRaiseType = crt_BetweenFloorUp) or (ConnRaiseType = crt_BetweenFloorDown) then
//begin
// ConnectedObjectsFromBetweenFloorConnector := GetConnectedObjectsFromBetweenFloorConnector(ConnObject);
// if ConnectedObjectsFromBetweenFloorConnector <> nil then
// for i := 0 to ConnectedObjectsFromBetweenFloorConnector.Count - 1 do
// begin
// FigureToResult := TFigure(ConnectedObjectsFromBetweenFloorConnector.List^[i]);
// if FigureToResult is TOrtholine then
// Result.Add(FigureToResult);
// end;
//end
//else
//begin
// for i := 0 to ConnObject.JoinedOrtholinesList.Count - 1 do
// begin
// JoinedLine := TOrthoLine(ConnObject.JoinedOrtholinesList.List^[i]);
// if JoinedLine <> TOrthoLine(AFigure) then
// Result.Add(JoinedLine);
// end;
// for i := 0 to ConnObject.JoinedConnectorsList.Count - 1 do
// begin
// FigureToResult := TConnectorObject(ConnObject.JoinedConnectorsList.List^[i]);
// Result.Add(FigureToResult);
// end;
//end;
// Ñòîðîíà 2
//ConnObject := TConnectorObject(TOrthoLine(AFigure).JoinConnector2);
//ConnRaiseType := ConnObject.FConnRaiseType;
//if (ConnRaiseType = crt_BetweenFloorUp) or (ConnRaiseType = crt_BetweenFloorDown) then
//begin
// ConnectedObjectsFromBetweenFloorConnector := GetConnectedObjectsFromBetweenFloorConnector(ConnObject);
// if ConnectedObjectsFromBetweenFloorConnector <> nil then
// for i := 0 to ConnectedObjectsFromBetweenFloorConnector.Count - 1 do
// begin
// FigureToResult := TFigure(ConnectedObjectsFromBetweenFloorConnector.List^[i]);
// if FigureToResult is TOrtholine then
// Result.Add(FigureToResult);
// end;
//end
//else
//begin
// for i := 0 to ConnObject.JoinedOrtholinesList.Count - 1 do
// begin
// JoinedLine := TOrthoLine(ConnObject.JoinedOrtholinesList.List^[i]);
// if JoinedLine <> TOrthoLine(AFigure) then
// Result.Add(JoinedLine);
// end;
// for i := 0 to ConnObject.JoinedConnectorsList.Count - 1 do
// begin
// FigureToResult := TConnectorObject(ConnObject.JoinedConnectorsList.List^[i]);
// Result.Add(FigureToResult);
// end;
//end;
GetObjectsFromOrtholineConnector(TConnectorObject(TOrthoLine(AFigure).JoinConnector1));
GetObjectsFromOrtholineConnector(TConnectorObject(TOrthoLine(AFigure).JoinConnector2));
end;
end;
function GetConnectorsOtherSides(aConnector: TConnectorObject): TList;
var
JoinedLine: TOrtholine;
RaiseConn: TConnectorObject;
i: Integer;
begin
Result := TList.Create;
for i := 0 to aConnector.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(aConnector.JoinedOrtholinesList[i]);
if JoinedLine.JoinConnector1 <> aConnector then
Result.Add(JoinedLine.JoinConnector1);
if JoinedLine.JoinConnector2 <> aConnector then
Result.Add(JoinedLine.JoinConnector2);
end;
// òðàññû ÷åðåç ñ-ï
RaiseConn := GetRaiseConn(aConnector);
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.JoinConnector1 <> RaiseConn then
Result.Add(JoinedLine.JoinConnector1);
if JoinedLine.JoinConnector2 <> RaiseConn then
Result.Add(JoinedLine.JoinConnector2);
end;
end;
end;
end;
function GetEndPointByHouse(aHouse: THouse; aCurrentWA: TConnectorObject): TConnectorObject;
var
i, j: Integer;
Joined: TConnectorObject;
AllTrace: TList;
begin
Result := nil;
try
for i := 0 to aHouse.fJoined.Count - 1 do
begin
Joined := TConnectorObject(aHouse.fJoined[i]);
AllTrace := GetAllTraceInCAD(Joined, aCurrentWA);
if (AllTrace <> nil) and (AllTrace.Count > 0) then
begin
Result := Joined;
exit;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.GetEndPointByHouse', E.Message);
end;
end;
procedure SetLineStatusInfo(aLineParams: PLineFigureParams);
var
i: integer;
vList: TF_CAD;
vFigure: TOrthoLine;
begin
try
vList := GetListByID(aLineParams.ListID);
if vList <> nil then
begin
vFigure := TOrthoLine(GetFigureByID(vList, aLineParams.FigureID));
if vFigure = nil then
vFigure := TOrthoLine(GetFigureByIDInSCSFigureGroups(vList, aLineParams.FigureID));
if vFigure <> nil then
begin
vFigure.FCableFullnessSide1 := aLineParams.FullnesCableSide1;
vFigure.FCableFullnessSide2 := aLineParams.FullnesCableSide2;
vFigure.FCableChannelFullness := aLineParams.ChannelFullness;
vFigure.FCableChannelClosedSide1 := aLineParams.ClosedTypeForChannelSide1;
vFigure.FCableChannelClosedSide2 := aLineParams.ClosedTypeForChannelSide1;
vFigure.FDefectDegree := aLineParams.DefectObjDegree;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.SetLineStatusInfo', E.Message);
end;
end;
procedure SetConnStatusInfo(aConnParams: PConnFigureParams);
var
i: integer;
vList: TF_CAD;
vFigure: TConnectorObject;
begin
try
vList := GetListByID(aConnParams.ListID);
if vList <> nil then
begin
vFigure := TConnectorObject(GetFigureByID(vList, aConnParams.FigureID));
if vFigure = nil then
vFigure := TConnectorObject(GetFigureByIDInSCSFigureGroups(vList, aConnParams.FigureID));
if vFigure <> nil then
begin
vFigure.FConnFullness := aConnParams.Fullness;
vFigure.FDefectDegree := aConnParams.DefectObjDegree;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.SetConnStatusInfo', E.Message);
end;
end;
procedure LoadSubWithMaster(aFName: string);
var
Jpeg: TJpegImage;
Bmp: TBMPObject;
begin
try
aFName := AnsiLowerCaseFileName(aFName);
// ïîäëîæêà
if pos('.scb', aFName) <> 0 then
begin
FSCS_Main.LoadSubstrate(aFName);
end
else
// àðõ. ïëàí
if pos('.sca', aFName) <> 0 then
begin
FSCS_Main.LoadFPlan(aFName);
end
else
// BMP
if pos('.bmp', aFName) <> 0 then
begin
GCadForm.PCad.InsertBitmap(1, 0, 0, aFName, false, false);
end
else
// JPG & JPEG
if (pos('.jpg', aFName) <> 0) or (pos('.jpeg', aFName) <> 0) then
begin
Bmp := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0, aFName, false, false));
Jpeg := TJpegImage.create;
Jpeg.LoadFromFile(aFName);
Bmp.Picture.Width := Jpeg.Width;
Bmp.Picture.Height := Jpeg.Height;
Bmp.Picture.Canvas.Draw(0, 0, Jpeg);
//Bmp.Picture.PixelFormat := pf24bit;
FreeAndNil(Jpeg);
end
// îäèí èç âåêòîðûõ ÷åðòåæåé
else
begin
LoadDXFFileWithName(GCadForm.PCad, aFName);
end;
GCadForm.PCad.DeselectAll(0);
except
on E: Exception do AddExceptionToLogEx('U_Common.LoadSubWithMaster', E.Message);
end;
end;
procedure CreateVerticalOnConnector(aConnector: TConnectorObject; aHeight: Double);
var
ConnectedConn: TConnectorObject;
VertConn: TConnectorObject;
VertLine: TOrthoLine;
x, y, z: double;
i: integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
ObjParams: TObjectParams;
begin
BaseBeginUpdate;
try
x := AConnector.ActualPoints[1].x;
y := AConnector.ActualPoints[1].y;
z := AConnector.ActualZOrder[1];
// ñîçäàòü ïîäúåì-ñïóñê êîííåêòîð
VertConn := TConnectorObject.Create(x, y, AHeight, AConnector.LayerHandle, mydsNormal, GCadForm.PCad);
VertConn.ConnectorType := ct_Clear;
// ñîçäàòü âåðòèêàëü ëèíèÿ
VertLine := TOrthoLine.Create(x, y, AHeight, x, y, z, 1,ord(psSolid), clBlack, 0, AConnector.LayerHandle, mydsNormal, GCadForm.PCad, False);
VertLine.SetJConnector1(TConnectorObject(AConnector));
VertLine.SetJConnector2(TConnectorObject(VertConn));
VertLine.ActualZOrder[1] := AConnector.ActualZOrder[1];
VertLine.ActualZOrder[2] := VertConn.ActualZOrder[1];
SetLineFigureCoordZInPM(VertLine.ID, 1, VertLine.ActualZOrder[1]);
SetLineFigureCoordZInPM(VertLine.ID, 2, VertLine.ActualZOrder[2]);
// ÑÎÇÄÀÒÜ ÍÀ ÊÀÄ ===========================================
GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), VertConn, False);
VertConn.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(VertConn.ID, VertConn.Name);
ObjParams := GetFigureParams(VertConn.ID);
VertConn.Name := ObjParams.Name;
VertConn.FIndex := ObjParams.MarkID;
GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), VertLine, False);
VertLine.Name := cCadClasses_Mes32;
SetNewObjectNameInPM(VertLine.ID, VertLine.Name);
ObjParams := GetFigureParams(VertLine.ID);
VertLine.Name := ObjParams.Name;
VertLine.FIndex := ObjParams.MarkID;
VertLine.FIsVertical := True;
VertLine.CalculLength := VertLine.LengthCalc;
VertLine.LineLength := VertLine.CalculLength;
SetLineFigureLengthInPM(VertLine.ID, VertLine.LineLength);
VertLine.ReCreateCaptionsGroup(True, false);
VertLine.UpdateLengthTextBox(True, false);
VertLine.ReCreateNotesGroup(True);
VertLine.ShowCaptions := False;
VertLine.ShowNotes := False;
VertLine.IsShowBlock := False;
// ***
for i := 0 to VertConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(VertConn.JoinedOrtholinesList[i]);
if JoinedLine <> VertLine then
begin
JoinedLine.CalculLength := JoinedLine.LengthCalc;
JoinedLine.LineLength := JoinedLine.CalculLength;
SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength);
JoinedLine.UpdateLengthTextBox(True, false);
JoinedLine.ReCreateDrawFigureBlock;
end;
end;
VertConn.LockMove := False;//True;
VertConn.LockModify := True;
VertLine.LockMove := False;
VertLine.LockModify := True;
SetConnBringToFront(AConnector);
SetConnBringToFront(VertConn);
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('U_Common.CreateVerticalTrace', E.Message);
end;
BaseEndUpdate;
end;
procedure CreateVerticalOnPointObject(aPointObject: TConnectorObject; aHeight: Double);
var
ConnectedConn: TConnectorObject;
VertConn: TConnectorObject;
VertLine: TOrthoLine;
x, y, z: double;
i: integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
JoinedConnBase: TConnectorObject;
ObjParams: TObjectParams;
TempRaisedConnectors: TList;
CurIndex: Integer;
begin
BaseBeginUpdate;
try
x := APointObject.ActualPoints[1].x;
y := APointObject.ActualPoints[1].y;
z := APointObject.ActualZOrder[1];
// ñîçäàòü ïðèñîåäèíåííûé êîííåêòîð
ConnectedConn := TConnectorObject.Create(x, y, z, APointObject.LayerHandle, mydsNormal, GCadForm.PCad);
ConnectedConn.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), ConnectedConn, False);
ConnectedConn.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name);
ObjParams := GetFigureParams(ConnectedConn.ID);
ConnectedConn.Name := ObjParams.Name;
ConnectedConn.FIndex := ObjParams.MarkID;
// ñîçäàòü âåðòèêàëü êîííåêòîð
VertConn := TConnectorObject.Create(x + 10, y - 10, AHeight, APointObject.LayerHandle, mydsNormal, GCadForm.PCad);
VertConn.ConnectorType := ct_Clear;
// ñîçäàòü âåðòèêàëü ëèíèÿ
VertLine := TOrthoLine.Create(x, y, z, x + 10, y - 10, AHeight, 1,ord(psSolid), clBlack, 0,
APointObject.LayerHandle, mydsNormal, GCadForm.PCad, False);
VertLine.SetJConnector1(TConnectorObject(ConnectedConn));
VertLine.SetJConnector2(TConnectorObject(VertConn));
VertLine.ActualZOrder[1] := ConnectedConn.ActualZOrder[1];
VertLine.ActualZOrder[2] := VertConn.ActualZOrder[1];
SetLineFigureCoordZInPM(VertLine.ID, 1, VertLine.ActualZOrder[1]);
SetLineFigureCoordZInPM(VertLine.ID, 2, VertLine.ActualZOrder[2]);
// ïðèêîííåêòèòü ïîäúåì
SnapConnectorToPointObject(ConnectedConn, APointObject, true);
ConnectedConn.MoveConnector(APointObject.ActualPoints[1].x - ConnectedConn.ActualPoints[1].x,
APointObject.ActualPoints[1].y - ConnectedConn.ActualPoints[1].y, false, false);
VertConn.MoveConnector(-10, 10, False);
// ÑÎÇÄÀÒÜ ÍÀ ÊÀÄ ===========================================
GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), VertConn, False);
VertConn.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(VertConn.ID, VertConn.Name);
ObjParams := GetFigureParams(VertConn.ID);
VertConn.Name := ObjParams.Name;
VertConn.FIndex := ObjParams.MarkID;
GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), VertLine, False);
VertLine.Name := cCadClasses_Mes32;
SetNewObjectNameInPM(VertLine.ID, VertLine.Name);
ObjParams := GetFigureParams(VertLine.ID);
VertLine.Name := ObjParams.Name;
VertLine.FIndex := ObjParams.MarkID;
VertLine.FIsVertical := True;
VertConn.LockMove := False;//True;
VertConn.LockModify := True;
VertLine.LockMove := False;
VertLine.LockModify := True;
ConnectedConn.LockMove := True;
ConnectedConn.LockModify := True;
// ïåðåïîäñîåäèíèòü òðàññû ê ïîäúåìó
TempRaisedConnectors := TList.Create;
for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]);
if JoinedConn <> ConnectedConn then
TempRaisedConnectors.Add(JoinedConn);
end;
// îòâÿçêà
for i := 0 to TempRaisedConnectors.Count - 1 do
begin
JoinedConn := TConnectorObject(TempRaisedConnectors[i]);
UnsnapConnectorFromPointObject(JoinedConn, APointObject, true);
end;
// ïåðåïðèâÿçêà ê âåðøèíå
CurIndex := TempRaisedConnectors.Count - 1;
// âÿçàòü áåç ñîðòèðîâîê
for i := CurIndex downto 0 do
begin
JoinedConn := TConnectorObject(TempRaisedConnectors[i]);
SnapConnectorToConnector(JoinedConn, VertConn, true);
VertConn := JoinedConn;
end;
if TempRaisedConnectors <> nil then
FreeAndNil(TempRaisedConnectors);
VertLine.CalculLength := VertLine.LengthCalc;
VertLine.LineLength := VertLine.CalculLength;
SetLineFigureLengthInPM(VertLine.ID, VertLine.LineLength);
VertLine.ReCreateCaptionsGroup(True, false);
VertLine.UpdateLengthTextBox(True, false);
VertLine.ReCreateNotesGroup(True);
VertLine.ShowCaptions := False;
VertLine.ShowNotes := False;
VertLine.IsShowBlock := False;
// ***
for i := 0 to VertConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(VertConn.JoinedOrtholinesList[i]);
if JoinedLine <> VertLine then
begin
JoinedLine.CalculLength := JoinedLine.LengthCalc;
JoinedLine.LineLength := JoinedLine.CalculLength;
SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength);
JoinedLine.UpdateLengthTextBox(True, false);
JoinedLine.ReCreateDrawFigureBlock;
end;
end;
SetConnBringToFront(APointObject);
SetConnBringToFront(VertConn);
RefreshCAD(GCadForm.PCad);
SetNewObjectNameInPM(VertConn.ID, VertConn.Name);
except
on E: Exception do AddExceptionToLogEx('U_Common.CreateVerticalOnPointObject', E.Message);
end;
BaseEndUpdate;
end;
// Tolik
// âåðòèêàëüíàÿ ëèíèÿ ïî äâóì òî÷êàì
procedure CreateVerticalOnTwoPointObjects(aPointObject1, APointObject2: TConnectorObject; aHeight: Double);
var
ConnectedConn: TConnectorObject;
VertConn: TConnectorObject;
VertLine: TOrthoLine;
x, y, z: double;
i: integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
JoinedConnBase: TConnectorObject;
ObjParams: TObjectParams;
TempRaisedConnectors: TList;
CurIndex: Integer;
begin
BaseBeginUpdate;
try
x := APointObject1.ActualPoints[1].x;
y := APointObject1.ActualPoints[1].y;
z := APointObject1.ActualZOrder[1];
// ñîçäàòü ïðèñîåäèíåííûé êîííåêòîð
ConnectedConn := TConnectorObject.Create(x, y, z, APointObject1.LayerHandle, mydsNormal, GCadForm.PCad);
ConnectedConn.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(APointObject1.LayerHandle), ConnectedConn, False);
ConnectedConn.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name);
ObjParams := GetFigureParams(ConnectedConn.ID);
ConnectedConn.Name := ObjParams.Name;
ConnectedConn.FIndex := ObjParams.MarkID;
// ñîçäàòü âåðòèêàëü êîííåêòîð
VertConn := TConnectorObject.Create(x + 10, y - 10, AHeight, APointObject1.LayerHandle, mydsNormal, GCadForm.PCad);
VertConn.ConnectorType := ct_Clear;
// ñîçäàòü âåðòèêàëü ëèíèÿ
VertLine := TOrthoLine.Create(x, y, z, x + 10, y - 10, AHeight, 1,ord(psSolid), clBlack, 0,
APointObject1.LayerHandle, mydsNormal, GCadForm.PCad, False);
VertLine.SetJConnector1(TConnectorObject(ConnectedConn));
VertLine.SetJConnector2(TConnectorObject(VertConn));
VertLine.ActualZOrder[1] := ConnectedConn.ActualZOrder[1];
VertLine.ActualZOrder[2] := VertConn.ActualZOrder[1];
SetLineFigureCoordZInPM(VertLine.ID, 1, VertLine.ActualZOrder[1]);
SetLineFigureCoordZInPM(VertLine.ID, 2, VertLine.ActualZOrder[2]);
// ïðèêîííåêòèòü ïîäúåì
SnapConnectorToPointObject(ConnectedConn, APointObject1, true);
ConnectedConn.MoveConnector(APointObject1.ActualPoints[1].x - ConnectedConn.ActualPoints[1].x,
APointObject1.ActualPoints[1].y - ConnectedConn.ActualPoints[1].y, false, false);
// Tolik
SnapConnectorToPointObject(VertConn, APointObject2, true);
VertConn.MoveConnector(APointObject2.ActualPoints[1].x - VertConn.ActualPoints[1].x,
APointObject2.ActualPoints[1].y - VertConn.ActualPoints[1].y, false, false);
// VertConn.MoveConnector(-10, 10, False);
// ÑÎÇÄÀÒÜ ÍÀ ÊÀÄ ===========================================
GCadForm.PCad.AddCustomFigure (GLN(APointObject1.LayerHandle), VertConn, False);
VertConn.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(VertConn.ID, VertConn.Name);
ObjParams := GetFigureParams(VertConn.ID);
VertConn.Name := ObjParams.Name;
VertConn.FIndex := ObjParams.MarkID;
GCadForm.PCad.AddCustomFigure (GLN(APointObject1.LayerHandle), VertLine, False);
VertLine.Name := cCadClasses_Mes32;
SetNewObjectNameInPM(VertLine.ID, VertLine.Name);
ObjParams := GetFigureParams(VertLine.ID);
VertLine.Name := ObjParams.Name;
VertLine.FIndex := ObjParams.MarkID;
VertLine.FIsVertical := True;
VertConn.LockMove := True;
VertConn.LockModify := True;
VertLine.LockMove := False;
VertLine.LockModify := True;
ConnectedConn.LockMove := True;
ConnectedConn.LockModify := True;
{ // ïåðåïîäñîåäèíèòü òðàññû ê ïîäúåìó
TempRaisedConnectors := TList.Create;
for i := 0 to APointObject1.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(APointObject1.JoinedConnectorsList[i]);
if JoinedConn <> ConnectedConn then
TempRaisedConnectors.Add(JoinedConn);
end;
// îòâÿçêà
for i := 0 to TempRaisedConnectors.Count - 1 do
begin
JoinedConn := TConnectorObject(TempRaisedConnectors[i]);
UnsnapConnectorFromPointObject(JoinedConn, APointObject1, true);
end;
// ïåðåïðèâÿçêà ê âåðøèíå
CurIndex := TempRaisedConnectors.Count - 1;
// âÿçàòü áåç ñîðòèðîâîê
for i := CurIndex downto 0 do
begin
JoinedConn := TConnectorObject(TempRaisedConnectors[i]);
SnapConnectorToConnector(JoinedConn, VertConn, true);
VertConn := JoinedConn;
end;
if TempRaisedConnectors <> nil then
FreeAndNil(TempRaisedConnectors); }
VertLine.CalculLength := VertLine.LengthCalc;
VertLine.LineLength := VertLine.CalculLength;
SetLineFigureLengthInPM(VertLine.ID, VertLine.LineLength);
VertLine.ReCreateCaptionsGroup(True, false);
VertLine.UpdateLengthTextBox(True, false);
VertLine.ReCreateNotesGroup(True);
VertLine.ShowCaptions := False;
VertLine.ShowNotes := False;
VertLine.IsShowBlock := False;
// ***
for i := 0 to VertConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(VertConn.JoinedOrtholinesList[i]);
if JoinedLine <> VertLine then
begin
JoinedLine.CalculLength := JoinedLine.LengthCalc;
JoinedLine.LineLength := JoinedLine.CalculLength;
SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength);
JoinedLine.UpdateLengthTextBox(True, false);
JoinedLine.ReCreateDrawFigureBlock;
end;
end;
SetConnBringToFront(APointObject1);
SetConnBringToFront(VertConn);
RefreshCAD(GCadForm.PCad);
SetNewObjectNameInPM(VertConn.ID, VertConn.Name);
except
on E: Exception do AddExceptionToLogEx('U_Common.CreateVerticalOnPointObject', E.Message);
end;
BaseEndUpdate;
end;
function CheckOtherConnectorsOnLevel(aSelf: TConnectorObject; X, Y: Double): TList;
var
i, j: integer;
GetConn: TConnectorObject;
GetLine: TOrthoLine;
isVertical: Boolean;
begin
Result := nil;
try
// IsVertical
isVertical := False;
if aSelf.JoinedConnectorsList.Count = 0 then
begin
for i := 0 to aSelf.JoinedOrtholinesList.Count - 1 do
begin
GetLine := TOrthoLine(aSelf.JoinedOrtholinesList[i]);
if GetLine.FIsVertical then
begin
isVertical := True;
Break;
end;
end;
end
else
begin
for i := 0 to aSelf.JoinedConnectorsList.Count - 1 do
begin
GetConn := TConnectorObject(aSelf.JoinedConnectorsList[i]);
for j := 0 to GetConn.JoinedOrtholinesList.Count - 1 do
begin
GetLine := TOrthoLine(GetConn.JoinedOrtholinesList[j]);
if GetLine.FIsVertical then
begin
isVertical := True;
Break;
end;
end;
end;
end;
if not isVertical then
exit;
Result := TList.Create;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then
begin
GetConn := TConnectorObject(GCadForm.PCad.Figures[i]);
if GetConn <> aSelf then
if GetConn.IsPointIn(X, Y) then
begin
if GetConn.ConnectorType <> ct_Clear then
Result.Add(GetConn)
else
if GetConn.JoinedConnectorsList.Count = 0 then
Result.Add(GetConn);
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.CheckOtherConnectorsOnLevel', E.Message);
end;
end;
procedure SetLiteStatus(aStatus: Boolean);
var
isPrjOpen: Boolean;
begin
try
GLiteVersion := aStatus;
if GLiteVersion then
begin
FSCS_Main.mainFormat.Visible := False;
FSCS_Main.mainTools.Visible := False;
FSCS_Main.tbsToolsExpert.Visible := False; //29.12.2011
FSCS_Main.tbLineExpert.Visible := False;
FSCS_Main.tbRectangleExpert.Visible := False;
FSCS_Main.tbEllipseExpert.Visible := False;
FSCS_Main.tbCircleExpert.Visible := False;
FSCS_Main.tbArcExpert.Visible := False;
FSCS_Main.tbElipticArcExpert.Visible := False;
FSCS_Main.tbPolyLineExpert.Visible := False;
FSCS_Main.tbPointExpert.Visible := False;
FSCS_Main.tbTextExpert.Visible := False;
FSCS_Main.tbRichTextExpert.Visible := False;
FSCS_Main.tbKnifeExpert.Visible := False;
FSCS_Main.tbHDimLineExpert.Visible := False;
FSCS_Main.tbVDimLineExpert.Visible := False;
//29.03.2012 FSCS_Main.tbWallRectExpert.Visible := False;
//29.03.2012 FSCS_Main.tbWallPathExpert.Visible := False;
FSCS_Main.tbHouseExpert.Visible := False;
//29.03.2012 FSCS_Main.tbWallRectNoob.Visible := False;
//29.03.2012 FSCS_Main.tbWallPathNoob.Visible := False;
FSCS_Main.tbHouseNoob.Visible := False;
FSCS_Main.aMasterAutoTrace.Visible := False;
FSCS_Main.aMasterAutoTraceElectric.Visible := False;
FSCS_Main.aCreateNormsOnCad.Visible := False;
FSCS_Main.aManual_Interfaces.Visible := False;
end
else
begin
FSCS_Main.mainFormat.Visible := True;
FSCS_Main.mainTools.Visible := True;
FSCS_Main.tbsToolsExpert.Visible := True; //29.12.2011
FSCS_Main.tbLineExpert.Visible := True;
FSCS_Main.tbRectangleExpert.Visible := True;
FSCS_Main.tbEllipseExpert.Visible := True;
FSCS_Main.tbCircleExpert.Visible := True;
FSCS_Main.tbArcExpert.Visible := True;
FSCS_Main.tbElipticArcExpert.Visible := True;
FSCS_Main.tbPolyLineExpert.Visible := True;
FSCS_Main.tbPointExpert.Visible := True;
FSCS_Main.tbTextExpert.Visible := True;
FSCS_Main.tbRichTextExpert.Visible := True;
FSCS_Main.tbKnifeExpert.Visible := True;
FSCS_Main.tbHDimLineExpert.Visible := True;
FSCS_Main.tbVDimLineExpert.Visible := True;
//29.03.2012 FSCS_Main.tbWallRectExpert.Visible := True;
//29.03.2012 FSCS_Main.tbWallPathExpert.Visible := True;
FSCS_Main.tbHouseExpert.Visible := True;
//29.03.2012 FSCS_Main.tbWallRectNoob.Visible := True;
//29.03.2012 FSCS_Main.tbWallPathNoob.Visible := True;
FSCS_Main.tbHouseNoob.Visible := True;
FSCS_Main.aMasterAutoTrace.Visible := True;
FSCS_Main.aMasterAutoTraceElectric.Visible := True;
FSCS_Main.aCreateNormsOnCad.Visible := True;
FSCS_Main.aManual_Interfaces.Visible := True;
end;
isPrjOpen := CheckIsOpenProject(false);
if FSCS_Main.Visible then //16.08.2012 - åñëè òîëüêî çàïóñê ïðîãðàììû, òî íåôèã âûçûâàòü îäíî è òîæå íåñêîëüêî ðàç
FSCS_Main.SetMenuStatus(isPrjOpen);
except
on E: Exception do AddExceptionToLogEx('U_Common.SetLiteStatus', E.Message);
end;
end;
function CheckJoinVertical(aObject: TConnectorObject): Boolean;
var
i, j: integer;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
begin
Result := false;
try
if aObject.ConnectorType = ct_clear then
begin
for i := 0 to aObject.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(aObject.JoinedOrtholinesList[i]);
if JoinedLine.FIsVertical then
begin
Result := True;
Break;
end;
end;
end
else
begin
for i := 0 to aObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]);
if JoinedLine.FIsVertical then
begin
Result := True;
Break;
end;
end;
if Result then //#From Oleg# //15.09.2010
Break; //// BREAK ////
end;
end;
except
on E: Exception do AddExceptionToLogEx('U_Common.CheckJoinVertical', E.Message);
end;
end;
procedure PutObjectOnHeight(aObject: TConnectorObject; aHeight: Double);
var
i, j: integer;
JoinedConn: TConnectorObject;
JoinedLine: TOrthoLine;
begin
try
AObject.ActualZOrder[1] := aHeight;
if aObject.ConnectorType = ct_Clear then
begin
for i := 0 to aObject.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := aObject.JoinedOrtholinesList[i];
if JoinedLine.JoinConnector1 = aObject then
begin
SetLineFigureCoordZInPM(JoinedLine.ID, 1, aObject.ActualZOrder[1]);
JoinedLine.ActualZOrder[1] := aObject.ActualZOrder[1];
end;
if JoinedLine.JoinConnector2 = aObject then
begin
SetLineFigureCoordZInPM(JoinedLine.ID, 2, aObject.ActualZOrder[1]);
JoinedLine.ActualZOrder[2] := aObject.ActualZOrder[1];
end;
JoinedLine.CalculLength := JoinedLine.LengthCalc;
JoinedLine.LineLength := JoinedLine.CalculLength;
SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength);
JoinedLine.UpdateLengthTextBox(True, true);
JoinedLine.ReCreateNotesGroup(True);
end;
end
else
begin
// óñòàíîâèòü íîâûå çíà÷åíèÿ
for i := 0 to aObject.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := aObject.JoinedConnectorsList[i];
JoinedConn.ActualZOrder[1] := aObject.ActualZOrder[1];
for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := JoinedConn.JoinedOrtholinesList[j];
if JoinedLine.JoinConnector1 = JoinedConn then
begin
SetLineFigureCoordZInPM(JoinedLine.ID, 1, aObject.ActualZOrder[1]);
JoinedLine.ActualZOrder[1] := aObject.ActualZOrder[1];
end;
if JoinedLine.JoinConnector2 = JoinedConn then
begin
SetLineFigureCoordZInPM(JoinedLine.ID, 2, aObject.ActualZOrder[1]);
JoinedLine.ActualZOrder[2] := aObject.ActualZOrder[1];
end;
JoinedLine.CalculLength := JoinedLine.LengthCalc;
JoinedLine.LineLength := JoinedLine.CalculLength;
SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength);
JoinedLine.UpdateLengthTextBox(True, true);
JoinedLine.ReCreateNotesGroup(True);
end;
SetConFigureCoordZInPM(JoinedConn.ID, JoinedConn.ActualZOrder[1]);
end;
end;
SetConFigureCoordZInPM(aObject.ID, aHeight);
except
on E: Exception do AddExceptionToLogEx('U_Common.PutObjectOnHeight', E.Message);
end;
end;
function GetJoinedVerticalObjects(AObject: TFigure; AOnlyConnectorCoordZ: PDouble=nil): TList;
var
FiguresToFind: TList;
NextFiguresToFind: TList;
LookedFigures: TList;
ConnectedFigures: TList;
i: Integer;
Figure: TFigure;
procedure AddFigureToRes(AFigureToRes: TFigure);
begin
if (AOnlyConnectorCoordZ = nil) or
((AFigureToRes is TConnectorObject) and (TConnectorObject(AFigureToRes).ActualZOrder[1] = AOnlyConnectorCoordZ^)) then
Result.Add(AFigureToRes);
end;
begin
Result := TList.Create;
FiguresToFind := TList.Create;
NextFiguresToFind := TList.Create;
LookedFigures := TList.Create;
FiguresToFind.Add(AObject);
while FiguresToFind.Count > 0 do
begin
for i := 0 to FiguresToFind.Count - 1 do
begin
Figure := TFigure(FiguresToFind[i]);
// Åñëè êîííåêòîð, èëè âåðòèêàëüíàÿ òðàññà
if (Figure is TConnectorObject) or ((Figure is TOrthoLine) and (TOrthoLine(Figure).FIsVertical)) then
begin
AddFigureToRes(Figure); //Result.Add(Figure);
// èùåì ïîäêëþ÷åííûå îáúåêòû
ConnectedFigures := GetConnectedFigures(Figure, true, LookedFigures);
NextFiguresToFind.Assign(ConnectedFigures, laOr);
ConnectedFigures.Free;
end;
LookedFigures.Add(Figure);
end;
// Ñëåäóþùèé íàáîð îáúåêòîâ äëÿ ïîèñêà
FiguresToFind.Assign(NextFiguresToFind, laCopy);
NextFiguresToFind.Clear;
end;
NextFiguresToFind.Free;
LookedFigures.Free;
FiguresToFind.Free;
end;
function GetJoinedVerticalConnectorByCoordZ(AStartConnector: TConnectorObject; ACoordZ: Double): TConnectorObject;
var
Connectors: TList;
begin
Result := nil;
Connectors := GetJoinedVerticalObjects(AStartConnector, @ACoordZ);
if Connectors.Count > 0 then
if (TObject(Connectors[0]) is TConnectorObject) then
Result := TConnectorObject(Connectors[0]);
Connectors.Free;
end;
function GetCADLayerNumByComponIsLine(AIsLine: Integer): Integer;
begin
Result := lnSCSCommon;
if IsArchComponByIsLine(AIsLine) then
Result := lnArch;
end;
procedure DefineCurrLayerByCompon;
var
Compon: TSCSComponent;
begin
if (GCadForm <> nil) and (GCadForm.FCreateObjectOnClick = true) then
begin
Compon := F_NormBase.GetActualSelectedComponent;
if Compon <> nil then
begin
GCadForm.CurrentLayer := GetCADLayerNumByComponIsLine(Compon.IsLine);
end;
end;
end;
procedure DropCreateObjectOnClickMode;
begin
if (GCadForm.FCreateObjectOnClick) then
FSCS_Main.aToolSelect.Execute;
end;
procedure BlockToNormalSize(ABlock: TBlock; AMaxSideSize: Integer);
var
Bnd: TDoubleRect;
w, h: double;
PixelsPerMm: Double;
PxCount: Double;
ZoomOut: Double;
CurrMaxSideSize: Double;
begin
Bnd := ABlock.GetBoundRect;
w := abs(Bnd.Right - Bnd.Left);
h := abs(Bnd.Bottom - Bnd.Top);
// Ïåðåâîäèì ìì â ïèêñåëè
w := w * GCadForm.PCad.DotsPerMilOrig;
h := h * GCadForm.PCad.DotsPerMilOrig;
////ABlock.ow
// // ïåðåâåñòè â ìì
// w := w * GCadForm.PCad.MapScale;
// h := h * GCadForm.PCad.MapScale;
//
// // Ïåðåâîäèì ìì â ïèêñåëè
// // PixelsPerInch / 25,4 - êîëè÷åñòâî òî÷åê â 1 ìì
// PixelsPerMm := (GCadForm.PixelsPerInch / 25.4);
// w := w * PixelsPerMm;
// h := h * PixelsPerMm;
// Îïðåäåëÿåì ìàêñ. êîë-âî ïèêñåëåé, âûõîäÿùåå çà ãðàíèöû
CurrMaxSideSize := h;
PxCount := h - AMaxSideSize;
if PxCount < (w - AMaxSideSize) then
begin
CurrMaxSideSize := w;
PxCount := w - AMaxSideSize;
end;
if PxCount > 0 then
begin
// Îïðåäåëÿåì êîýôô. â ñêîëüêî ðàç íóæíî óìåíüøèòü
ZoomOut := (CurrMaxSideSize - PxCount) / CurrMaxSideSize;
//StretchBitmap(ABitmap, Round(ABitmap.Height/ZoomOut), Round(ABitmap.Width/ZoomOut));
ABlock.Scale(ZoomOut, ZoomOut, ABlock.ap1);
end;
end;
procedure Remove3DModelStream;
var
fFileName: string;
//08.09.2011 Buffer: array[0..1023] of Char;
TempPath: string;
begin
try
//08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
//08.09.2011 fFileName := TempPath + '3dmodel.pwd';
fFileName := GetAnsiTempPath + '3dmodel.pwd';
DeleteFile(fFileName);
except
on E: Exception do AddExceptionToLogEx('U_Common.Remove3DModelStream', E.Message);
end;
end;
function CreateTraceByPoints(APCAD: TPowerCad; AP1, AP2: TDoublePoint; aPosTraceBetweenPM: boolean = false; aH1: double = 0; aH2: double = 0): TOrtholine;
var
LHandle: Integer;
LineHeight: Double;
Conn1, Conn2: TConnectorObject;
function AddConnector(APoint: PDoublePoint): TConnectorObject;
begin
Result := TConnectorObject.Create(APoint^.x, APoint^.y, LineHeight, LHandle, mydsNormal, APCAD);
Result.ConnectorType := ct_Clear;
APCAD.AddCustomFigure(GLN(LHandle), Result, false);
//SnapConnectorToOrtholine(Result, Result);
SetConnBringToFront(Result);
end;
begin
LHandle := APCAD.GetLayerHandle(lnSCSCommon);
LineHeight := TF_CAD(APCAD.Parent).FLineHeight;
if aPosTraceBetweenPM then
Result := TOrthoLine.Create(AP1.x, AP1.y, aH1, AP2.x, AP2.y, aH2,
1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, APCAD)
else
Result := TOrthoLine.Create(AP1.x, AP1.y, LineHeight, AP2.x, AP2.y, LineHeight,
1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, APCAD);
APCAD.AddCustomFigure(GLN(LHandle), Result, false);
APCAD.OrderFigureToFront(TOrtholine(Result).CaptionsGroup);
Result.SetJConnector1(AddConnector(@AP1));
Result.SetJConnector2(AddConnector(@AP2));
end;
function CreateTraceByConnectors(aCAD: TF_CAD; aConn1, aConn2: TConnectorObject; aOrthogonally: Boolean=false; aTraceBetweenPM: Boolean = False): TOrtholine;
var
ConnIH, ConnH: Double;
SelectedList: TList;
//MiddlePt: TDoublePoint;
MiddleConn: TConnectorObject;
Conn1Pt, Conn2Pt: TDoublePoint;
begin
ConnIH := -100000;
ConnH := -100000;
if (aConn1.ConnectorType <> ct_Clear) then
ConnIH := aConn1.ActualZOrder[1];
if (aConn2.ConnectorType <> ct_Clear) then
ConnH := aConn2.ActualZOrder[1];
{if aOrthogonally then
begin
aOrthogonally := false;
// Ïðîâåðêà íóæíî ëè ñîçäàòü îðòîãîíàëüíóþ ëèíèþ
if Not CmpFloatByCP(aConn1.ActualPoints[1].x, aConn2.ActualPoints[1].x) then
begin
MiddlePt.x := aConn1.ActualPoints[1].x;
MiddlePt.y := aConn2.ActualPoints[1].y;
aOrthogonally := true;
DefinedMiddleX := true;
end
else if Not CmpFloatByCP(aConn1.ActualPoints[1].y, aConn2.ActualPoints[1].y) then
begin
MiddlePt.y := aConn1.ActualPoints[1].y;
MiddlePt.x := aConn2.ActualPoints[1].x;
aOrthogonally := true;
end;
end;}
//if aOrthogonally then
//begin
// Conn1Pt := aConn1.ActualPoints[1];
// Conn2Pt := aConn2.ActualPoints[1];
//end;
if ((ConnIH = -100000) or (ConnH = -100000)) then
Result := CreateTraceByPoints(aCAD.PCad, aConn1.ActualPoints[1], aConn2.ActualPoints[1], False)
else
Result := CreateTraceByPoints(aCAD.PCad, aConn1.ActualPoints[1], aConn2.ActualPoints[1], True, ConnIH, ConnH);
if aConn1.ConnectorType = ct_Clear then
SnapConnectorToConnector(TConnectorObject(Result.JoinConnector1), aConn1)
else
SnapConnectorToPointObject(TConnectorObject(Result.JoinConnector1), aConn1, False, aTraceBetweenPM);
if aConn2.ConnectorType = ct_Clear then
SnapConnectorToConnector(TConnectorObject(Result.JoinConnector2), aConn2)
else
SnapConnectorToPointObject(TConnectorObject(Result.JoinConnector2), aConn2, False, aTraceBetweenPM);
// NEW FROM OLEG:
//06.08.2013 - âîñòàíîâëåíèå ñîåäèíèòåëÿ ïîñëå ñíåïà
// Îëåã ÷å òî çàêîìåíòèë ïî èòîãó
{if TConnectorObject(Result.JoinConnector1).JoinedConnectorsList.Count > 0 then
if aConn1 <> TConnectorObject(Result.JoinConnector1).JoinedConnectorsList[0] then
aConn1 := TConnectorObject(Result.JoinConnector1).JoinedConnectorsList[0];
if TConnectorObject(Result.JoinConnector2).JoinedConnectorsList.Count > 0 then
if aConn2 <> TConnectorObject(Result.JoinConnector2).JoinedConnectorsList[0] then
aConn2 := TConnectorObject(Result.JoinConnector2).JoinedConnectorsList[0];}
//////////// âîññòàíîâèòü âûñîòû ÈÌÅÍÍÎ îáúåêòîâ ê êîòîðûì ïðèöåïèëè òðàññó
(* Èíîãäà ÀÂ-õè ñêðûòûå äàåò ïî ïåðâîìó ïðèíöèïó àâòîñîçäàíèÿ òðàññ *)
(* îñòàâèì ïîêà òàê *)
//LAST VER - Èíîãäà ãëþ÷èò
if Not FileExists(ExeDir + '\NoCorrectZ.ini') then
begin
// RefreshCAD(GCadForm.PCad);
// SetProjectChanged(True);
try
if (ConnIH <> -100000) and (assigned(aConn1)) then // check
//if aConn1.ClassName = 'TConnectorObject' then
begin
if aConn1.ActualZOrder[1] <> ConnIH then
begin
ChangeObjZ(aConn1, ConnIH);
end;
end;
except
end;
try
if (ConnH <> -100000) and (assigned(aConn2)) then // check
//if aConn2.ClassName = 'TConnectorObject' then
begin
if aConn2.ActualZOrder[1] <> ConnH then
begin
ChangeObjZ(aConn2, ConnH);
end;
end;
except
end;
end;
(* ïðîáóåì òàê *)
(* òàê õðåíîâî - ñîçäàåò ëèøíèå ñ/ï åñëè ê ïðèìåðó óæå áûë ñ/ï
if Result.JoinConnector1 <> nil then
if TConnectorObject(Result.JoinConnector1).ActualZOrder[1] <> ConnIH then
ChangeObjZ(TConnectorObject(Result.JoinConnector1), ConnIH);
if Result.JoinConnector2 <> nil then
if TConnectorObject(Result.JoinConnector2).ActualZOrder[1] <> ConnH then
ChangeObjZ(TConnectorObject(Result.JoinConnector2), ConnH);
*)
{if (aConn1.ConnectorType <> ct_Clear) and (aConn2.ConnectorType <> ct_Clear) then
begin
if aConn1.ActualZOrder[1] <> ConnIH then
ChangeObjZ(aConn1, ConnIH);
if aConn2.ActualZOrder[1] <> ConnH then
ChangeObjZ(aConn2, ConnH);
end;}
//Tolik
if ((not aTraceBetweenPM) or (ConnIH = -100000) or (ConnH = -100000))then
begin
//
if (aCAD.FLineHeight <> Result.ActualZOrder[1]) or (aCAD.FLineHeight <> Result.ActualZOrder[2]) then
begin
SelectedList := TList.Create;
SelectedList.Add(Result);
RaiseLineOnHeight(Result, aCAD.FLineHeight, SelectedList);
SetProjectChanged(True);
SelectedList.Free;
end;
end;
if aOrthogonally then
begin
// Ïðè àâòîñîçäàíèè ì-ý ÷àùå aConn1=Øê, aConn2=Ñîåä. èç ì-ý
Conn1Pt := Result.JoinConnector1.Ap1;
Conn2Pt := Result.JoinConnector2.Ap1;
if Not CmpFloatByCP(Conn1Pt.x, Conn2Pt.x) and Not CmpFloatByCP(Conn1Pt.y, Conn2Pt.y) then
begin
MiddleConn := DivideLineSimple(Result);
if MiddleConn <> nil then
begin
//MiddleConn.Move(Conn2Pt.x-MiddleConn.ActualPoints[1].x, Conn1Pt.y-MiddleConn.ActualPoints[1].y);
MiddleConn.Move(Conn1Pt.x-MiddleConn.ActualPoints[1].x, Conn2Pt.y-MiddleConn.ActualPoints[1].y);
end;
end;
end;
end;
function DivTraceOnPt(ATrace: TOrtholine; APt: TDoublePoint; ATraceList: TList): TConnectorObject;
var
i: Integer;
NewConn: TConnectorObject;
begin
Result := nil;
//29.07.2013 if Not (PointNear(ATrace.ActualPoints[1], APt) or PointNear(ATrace.ActualPoints[2], APt)) then
if Not (PointNear(ATrace.ActualPoints[1], APt, 0.3) or PointNear(ATrace.ActualPoints[2], APt, 0.3)) then
//if Not (EQDP(ATrace.ActualPoints[1], APt) or EQDP(ATrace.ActualPoints[2], APt)) then
begin
NewConn := DivideLineSimple(ATrace, @APt);
if ATraceList <> nil then
for i := 0 to NewConn.JoinedOrtholinesList.Count - 1 do
begin
if TOrtholine(NewConn.JoinedOrtholinesList[i]) <> ATrace then
ATraceList.Add(TOrtholine(NewConn.JoinedOrtholinesList[i]));
end;
Result := NewConn;
end;
end;
function GetMinConnector(AConn1, AConn2: TConnectorObject): TConnectorObject;
var
dist1, dist2: Double;
begin
Result := AConn1;
dist1 := GetLineLenght(AConn1.ActualPoints[1], DoublePoint(0,0));
dist2 := GetLineLenght(AConn2.ActualPoints[1], DoublePoint(0,0));
if dist2 < dist1 then
Result := AConn2;
end;
procedure ChangeObjZ(aObject: TConnectorObject; aZ: Double);
var
i, j: integer;
JoinedLine: TOrthoLine;
JoinedConn: TConnectorObject;
ObjFromRaise: TConnectorObject;
ZCoord: Double;
mess: string;
begin
try
ZCoord := aZ;
// Ñîåäèíèòåëü -----------------------------------------------------
if aObject.ConnectorType = ct_Clear then
begin
// Îí íå ñ-ï è íà íåì íåò ñ-ï
if (aObject.FConnRaiseType = crt_None) and (GetRaiseConn(aObject) = nil) then
CreateRaiseOnConnector(aObject, ZCoord)
else
// íà íåì åñòü ñ-ï
if GetRaiseConn(aObject) <> nil then
begin
ChangeRaiseOnConnector(aObject, ZCoord);
// SP !!!
// CheckDeleteAllRaises(GCadForm.PCad);
end
else
// ýòî ñ-ï
if (aObject.FConnRaiseType = crt_OnFloor) then
begin
ObjFromRaise := aObject.FObjectFromRaise;
if ZCoord = ObjFromRaise.ActualZOrder[1] then
begin
mess := cSCSObjectProp_Mes1;
if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cSCSObjectProp_Mes2, MB_YESNO) = IDYes then
begin
if ObjFromRaise.ConnectorType = ct_Clear then
DestroyRaiseOnConnector(ObjFromRaise)
else
DestroyRaiseOnPointObject(ObjFromRaise);
end
else
begin
aObject.ActualZOrder[1] := ZCoord;
SetConFigureCoordZInPM(aObject.ID, aObject.ActualZOrder[1]);//24.10.2012
end;
end
else
begin
aObject.ActualZOrder[1] := ZCoord;
SetConFigureCoordZInPM(aObject.ID, aObject.ActualZOrder[1]);//24.10.2012
end;
end
end
else
// Îáúåêò ----------------------------------------------------------
begin
// Îí íå ñ-ï è íà íåì íåò ñ-ï
if (aObject.FConnRaiseType = crt_None) and (GetRaiseConn(aObject) = nil) then
begin
if aObject.JoinedConnectorsList.Count = 0 then
begin
aObject.ActualZOrder[1] := ZCoord;
SetConFigureCoordZInPM(aObject.ID, ZCoord);
end
else
CreateRaiseOnPointObject(aObject, ZCoord);
end
else
// íà íåì åñòü ñ-ï
if GetRaiseConn(aObject) <> nil then
begin
// òîëüêî ïîäúåì-ñïóñê
begin
if aObject.JoinedConnectorsList.Count = 0 then
begin
aObject.ActualZOrder[1] := ZCoord;
SetConFigureCoordZInPM(aObject.ID, ZCoord);
end
else
begin
ChangeRaiseOnPointObject(aObject, ZCoord);
// SP !!!
// CheckDeleteAllRaises(GCadForm.PCad);
end;
end;
end
else
// ýòî ñ-ï
if (aObject.FConnRaiseType = crt_OnFloor) then
begin
ObjFromRaise := aObject.FObjectFromRaise;
if ZCoord = ObjFromRaise.ActualZOrder[1] then
begin
mess := cSCSObjectProp_Mes1;
if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cSCSObjectProp_Mes2, MB_YESNO) = IDYes then
begin
if ObjFromRaise.ConnectorType = ct_Clear then
DestroyRaiseOnConnector(ObjFromRaise)
else
DestroyRaiseOnPointObject(ObjFromRaise);
end
else
begin
aObject.ActualZOrder[1] := ZCoord;
SetConFigureCoordZInPM(aObject.ID, aObject.ActualZOrder[1]);//24.10.2012
end;
end
else
begin
aObject.ActualZOrder[1] := ZCoord;
SetConFigureCoordZInPM(aObject.ID, aObject.ActualZOrder[1]);//24.10.2012
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TF_ConnectorProperties.ChangeConnZ', E.Message);
end;
end;
function AutoCreateTraces(aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): Integer;
var
CAD: TF_CAD;
Figures: TList;
FFigure: TFigure;
//ConnI, ConnJ, Conn: TConnectorObject;
Conn, ConnTmp: TConnectorObject;
Conn1, Conn2: TConnectorObject;
//24.06.2013 ConnIH, ConnH: Double;
i, j, k: Integer;
Traces: TList;
Trace: TOrtholine;
CanWhile: Boolean;
ConnectorsCount: Integer;
TraceExsistFromTo: TStringList;
idFrom, idTo: string;
TestConn: TConnectorObject;
NoNearObjectList: TIntList;
ProgressCount: integer;
//24.06.2013 SelectedList: TList;
function FindNearObject(AObj: TConnectorObject): TConnectorObject;
var
CurrConDist, ConnDist: Double;
Conn: TConnectorObject;
j: Integer;
begin
Result := nil;
ConnDist := 0;
// Èùåì ñàìûé áëèæíèé ò.î.
for j := 0 to Figures.Count - 1 do
begin
Conn := TConnectorObject(Figures[j]);
if Conn <> AObj then
begin
CurrConDist := GetLineLenght(Conn.ActualPoints[1], AObj.ActualPoints[1]);
if (CurrConDist > 0) and ((ConnDist = 0) or (CurrConDist < ConnDist)) then
begin
//if Conn.Handle > AObj.Handle then
//begin
// idFrom := inttostr(AObj.Handle);
// idTo := inttostr(Conn.Handle);
//end
//else
//begin
// idFrom := inttostr(Conn.Handle);
// idTo := inttostr(AObj.Handle);
//end;
//if TraceExsistFromTo.IndexOf(idFrom + '_to_' + idTo) = -1 then
begin
Traces := GetAllTraceInCAD(Conn, AObj);
// Åñëè íåòó ïîäêëþ÷åíèÿ òðàññàìè
if Traces = nil then
begin
Result := Conn;
ConnDist := CurrConDist;
end
else
begin
//TraceExsistFromTo.Values[idFrom + '_to_' + idTo] := '1';
//TraceExsistFromTo.Add(idFrom + '_to_' + idTo);
end;
FreeAndNil(Traces);
end;
end;
end;
end;
end;
function FiguresCompare(Item1, Item2: Pointer): Integer;
var
dist1, dist2: Double;
begin
dist1 := GetLineLenght(TConnectorObject(Item1).ActualPoints[1], DoublePoint(0,0));
dist2 := GetLineLenght(TConnectorObject(Item2).ActualPoints[1], DoublePoint(0,0));
Result := 0;
if dist1 < dist2 then
Result := -1
else
if dist1 > dist2 then
Result := 1;
end;
begin
Result := 0;
CAD := GCadForm;
if Not aSimulate then
begin
CAD.SaveForUndo(uat_None, true, False);
BeginProgress;
end;
try
{//29.07.2013
Figures := TList.Create;
// Ôîðìèðóåì ñïèñîê òî÷. îáúåêòîâ
for i := 0 to CAD.PCad.FigureCount - 1 do
begin
FFigure := TFigure(CAD.PCad.Figures[i]);
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
Conn := TConnectorObject(FFigure);
if (Conn.ConnectorType = ct_NB) and (Conn.FTrunkName = '') then
begin
if Conn.Selected or (aSimulate and aSimulateForAllObj) then
Figures.Add(FFigure);
end;
end;
end;}
Figures := GetConnFiguresForAutoCreateTraces(CAD, aSimulate, aSimulateForAllObj, aSimulateForAnyTrace);
Figures.Sort(@FiguresCompare);
finally
if Not aSimulate then
EndProgress;
end;
try
if Figures.Count > 0 then
begin
TraceExsistFromTo := TStringList.Create;
NoNearObjectList := TIntList.Create;
if Not aSimulate then
BeginProgress('', Figures.Count);
ProgressCount := Figures.Count;
try
i := 0;
while i < Figures.Count do
begin
Conn := TConnectorObject(Figures[i]);
ConnectorsCount := 0;
CanWhile := true;
while CanWhile do
begin
Conn1 := Conn;
//if NoNearObjectList.IndexOf(Conn.Handle) = -1 then
//begin
Conn2 := FindNearObject(Conn);
// if Conn2 = nil then
// NoNearObjectList.Add(Conn.Handle);
//end
//else
// Conn2 := nil;
if Conn2 <> nil then
begin
// Åñëè ó íàéäåííîãî áëèæíåãî îáúåêòà åñòü áîëåå áëèæíèé îáúåêò, òî íè÷åãî íå ñîåäèíÿåì
//if NoNearObjectList.IndexOf(Conn2.Handle) = -1 then
//begin
ConnTmp := FindNearObject(Conn2);
// if (ConnTmp = nil) then
// NoNearObjectList.Add(Conn2.Handle);
//end
//else
// ConnTmp := nil;
//if (ConnTmp <> nil) and (ConnTmp <> Conn2) then
if (ConnTmp <> nil) and (ConnTmp <> Conn2) and (ConnTmp <> Conn1) then
if GetLineLenght(Conn2.ActualPoints[1], ConnTmp.ActualPoints[1]) < GetLineLenght(Conn2.ActualPoints[1], Conn1.ActualPoints[1]) then
begin
Conn2 := nil; //Conn1 := ConnTmp;
// Ïåðåìåùàåì îáúåêò Conn â êîíåö ñïèñêà
Figures.Delete(i);
Figures.Add(Conn);
i := i - 1;
Break; //// BREAK ////
end;
end;
if Conn2 <> nil then
begin
Result := Result + 1;
if Not aSimulate then
begin
{//24.06.2013 - moved to CreateTraceByConnectors
ConnIH := Conn1.ActualZOrder[1];
ConnH := Conn2.ActualZOrder[1];
Trace := CreateTraceByPoints(CAD.PCad, Conn1.ActualPoints[1], Conn2.ActualPoints[1]);
SnapConnectorToPointObject(TConnectorObject(Trace.JoinConnector1), Conn1);
SnapConnectorToPointObject(TConnectorObject(Trace.JoinConnector2), Conn2);
// 19.06.2013 IGOR
// òàê êðèâîâàòî
//if CAD.FLineHeight <> ConnIH then
// CreateRaiseOnPointObject(Conn1, CAD.FLineHeight, TConnectorObject(Trace.JoinConnector1));
//if CAD.FLineHeight <> ConnH then
// CreateRaiseOnPointObject(Conn2, CAD.FLineHeight, TConnectorObject(Trace.JoinConnector2));
// 19.06.2013 IGOR
// Ëó÷øå ñäåëàåì òàê
if Conn1.ActualZOrder[1] <> ConnIH then
ChangeObjZ(Conn1, ConnIH);
if Conn2.ActualZOrder[1] <> ConnH then
ChangeObjZ(Conn2, ConnH);
if (CAD.FLineHeight <> Trace.ActualZOrder[1]) or (CAD.FLineHeight <> Trace.ActualZOrder[2]) then
begin
SelectedList := TList.Create;
SelectedList.Add(Trace);
RaiseLineOnHeight(Trace, CAD.FLineHeight, SelectedList);
SetProjectChanged(True);
SelectedList.Free;
end;
// 19.06.2013 IGOR}
Trace := CreateTraceByConnectors(CAD, Conn1, Conn2); //24.06.2013
ConnectorsCount := ConnectorsCount + 1;
{
if Conn1.Handle > Conn2.Handle then
begin
idFrom := inttostr(Conn2.Handle);
idTo := inttostr(Conn1.Handle);
end
else
begin
idFrom := inttostr(Conn1.Handle);
idTo := inttostr(Conn2.Handle);
end;
if TraceExsistFromTo.IndexOf(idFrom + '_to_' + idTo) = -1 then
TraceExsistFromTo.Add(idFrom + '_to_' + idTo);
//Äîáàâèòü âñå èìåþùèåñÿ ïîäêëþ÷åíèÿ ñ îáåèõ êîííåêòîðîâ...
for k := 0 to Figures.Count - 1 do
begin
TestConn := TConnectorObject(Figures[k]);
// íàéòè â ñïèñêå äðóãèå ïîäêëþ÷åíèÿ îò êîííåêòîðà Conn2
if TestConn <> Conn2 then
begin
if TestConn.Handle > Conn2.Handle then
begin
idFrom := inttostr(Conn2.Handle);
idTo := inttostr(TestConn.Handle);
end
else
begin
idFrom := inttostr(TestConn.Handle);
idTo := inttostr(Conn2.Handle);
end;
if TraceExsistFromTo.IndexOf(idFrom + '_to_' + idTo) <> -1 then
begin
if TestConn.Handle > Conn1.Handle then
begin
idFrom := inttostr(Conn1.Handle);
idTo := inttostr(TestConn.Handle);
end
else
begin
idFrom := inttostr(TestConn.Handle);
idTo := inttostr(Conn1.Handle);
end;
if TraceExsistFromTo.IndexOf(idFrom + '_to_' + idTo) = -1 then
TraceExsistFromTo.Add(idFrom + '_to_' + idTo);
end;
end;
// íàéòè â ñïèñêå äðóãèå ïîäêëþ÷åíèÿ îò êîííåêòîðà Conn1
if TestConn <> Conn1 then
begin
if TestConn.Handle > Conn1.Handle then
begin
idFrom := inttostr(Conn1.Handle);
idTo := inttostr(TestConn.Handle);
end
else
begin
idFrom := inttostr(TestConn.Handle);
idTo := inttostr(Conn1.Handle);
end;
if TraceExsistFromTo.IndexOf(idFrom + '_to_' + idTo) <> -1 then
begin
if TestConn.Handle > Conn2.Handle then
begin
idFrom := inttostr(Conn2.Handle);
idTo := inttostr(TestConn.Handle);
end
else
begin
idFrom := inttostr(TestConn.Handle);
idTo := inttostr(Conn2.Handle);
end;
if TraceExsistFromTo.IndexOf(idFrom + '_to_' + idTo) = -1 then
TraceExsistFromTo.Add(idFrom + '_to_' + idTo);
end;
end;
end;
}
end
else
begin
if aSimulateForAnyTrace then
Exit ///// EXIT /////
else
begin
Figures.Delete(i);
Figures.Add(Conn);
i := i - 1;
Break; //// BREAK ////
end;
end;
end
else
begin
Application.ProcessMessages;
CanWhile := false;
if Not aSimulate then
begin
if (i mod 2) = 0 then
begin
Dec(ProgressCount);
if ProgressCount > 0 then
StepProgress;
end;
end;
end;
end;
if ConnectorsCount > 0 then
if Not aSimulate then
begin
Dec(ProgressCount);
if ProgressCount > 0 then
StepProgress;
end;
i := i + 1;
end;
finally
if Not aSimulate then
EndProgress;
end;
FreeAndNil(TraceExsistFromTo);
FreeAndNil(NoNearObjectList);
end;
finally
Figures.Free;
end;
end;
function AutoCreateTracesParallel(aSrcFigure: TFigure; aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): Integer;
var
CAD: TF_CAD;
Figures: TList;
FFigure: TFigure;
Conn: TConnectorObject;
i: Integer;
Trace: TOrtholine;
function FiguresCompare(Item1, Item2: Pointer): Integer;
var
dist1, dist2: Double;
begin
dist1 := GetLineLenght(TConnectorObject(Item1).ActualPoints[1], DoublePoint(0,0));
dist2 := GetLineLenght(TConnectorObject(Item2).ActualPoints[1], DoublePoint(0,0));
Result := 0;
if dist1 < dist2 then
Result := -1
else
if dist1 > dist2 then
Result := 1;
end;
begin
Result := 0;
if aSrcFigure <> nil then
if CheckFigureByClassName(aSrcFigure, cTConnectorObject) then
begin
CAD := GCadForm;
if Not aSimulate then
begin
CAD.SaveForUndo(uat_None, true, False);
BeginProgress;
end;
try
Figures := TList.Create;
// Ôîðìèðóåì ñïèñîê òî÷. îáúåêòîâ
for i := 0 to CAD.PCad.FigureCount - 1 do
begin
FFigure := TFigure(CAD.PCad.Figures[i]);
if (FFigure <> aSrcFigure) and CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
Conn := TConnectorObject(FFigure);
if (Conn.ConnectorType = ct_NB) and (Conn.FTrunkName = '') then
begin
if Conn.Selected or (aSimulate and aSimulateForAllObj) then
Figures.Add(FFigure);
end;
end;
end;
Figures.Sort(@FiguresCompare);
finally
if Not aSimulate then
EndProgress;
end;
if Figures.Count > 0 then
begin
if Not aSimulate then
BeginProgress('', Figures.Count);
try
for i := 0 to Figures.Count - 1 do
begin
Conn := TConnectorObject(Figures[i]);
Trace := CreateTraceByConnectors(CAD, TConnectorObject(aSrcFigure), Conn);
if Trace <> nil then
Inc(Result);
StepProgress;
end;
finally
Figures.Free;
if Not aSimulate then
EndProgress;
end;
end;
end;
end;
function AutoCreateTracesToTraceList(aTraces: TList; aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): Integer;
const
ptDelta = 0.3;
var
TraceList: TList;
CAD: TF_CAD;
ConnFigures: TList;
Conn1, Conn2: TConnectorObject;
i: Integer;
IsOrthoTrace: Boolean;
function IsNearPt(aPt1, aPt2: TDoublePoint; var aNearDist, aCurrDist: Double): Boolean;
begin
Result := false;
aCurrDist := GetLineLenght(aPt1, aPt2);
if (aCurrDist > 0) and ((aNearDist = 0) or (aCurrDist < aNearDist)) then
begin
aNearDist := aCurrDist;
Result := true;
end;
end;
function FindNearObject(AObj: TConnectorObject): TConnectorObject;
var
CurrConDist, ConnDist: Double;
CrossPtTrace: TOrtholine;
CrossPt, CurrCrossPt: TDoublePoint;
Trace: TOrtholine;
NewTraces: TList;
//Conn: TConnectorObject;
i: Integer;
begin
Result := nil;
ConnDist := 0;
CrossPtTrace := nil;
// Èùåì ñàìóþ áëèæíþþ ÷àñòü òðàññû
i := 0;
while i < TraceList.Count do
begin
Trace := TOrtholine(TraceList[i]);
if Trace.JoinConnector1 <> nil then
if IsNearPt(Trace.JoinConnector1.ActualPoints[1], AObj.ActualPoints[1], ConnDist, CurrConDist) then
begin
Result := TConnectorObject(Trace.JoinConnector1);
CrossPtTrace := nil;
end;
if Trace.JoinConnector2 <> nil then
if IsNearPt(Trace.JoinConnector2.ActualPoints[1], AObj.ActualPoints[1], ConnDist, CurrConDist) then
begin
Result := TConnectorObject(Trace.JoinConnector2);
CrossPtTrace := nil;
end;
CurrCrossPt := AObj.ActualPoints[1];
PointToLineByAngle(Trace.ActualPoints[1], Trace.ActualPoints[2], CurrCrossPt);
// Åñëè òî÷êà ïåðåñå÷åíèÿ íå ðÿäîì, òîãäà ðàñìàòðèâàåì åå äëÿ ñîçäàíèÿ òðàññû
if isPointinLine(Trace.ActualPoints[1], Trace.ActualPoints[2], CurrCrossPt, 0, 0.1) then
if (GetLineLength(Trace.ActualPoints[1], CurrCrossPt) >= ptDelta) and (GetLineLength(Trace.ActualPoints[2], CurrCrossPt) >= ptDelta) then
if IsNearPt(CurrCrossPt, AObj.ActualPoints[1], ConnDist, CurrConDist) then
begin
Result := nil;
CrossPtTrace := Trace;
CrossPt := CurrCrossPt;
end;
Inc(i);
end;
if (Result = nil) and (CrossPtTrace <> nil) then
begin
NewTraces := TList.Create;
Result := DivTraceOnPt(CrossPtTrace, CrossPt, NewTraces);
TraceList.Assign(NewTraces, laOr);
NewTraces.Free;
end;
end;
begin
//Tolik
Result := 0;
//
TraceList := TList.Create;
TraceList.Assign(aTraces);
CAD := GCadForm;
if Not aSimulate then
begin
CAD.SaveForUndo(uat_None, true, False);
BeginProgress;
end;
try
ConnFigures := GetConnFiguresForAutoCreateTraces(CAD, aSimulate, aSimulateForAllObj, aSimulateForAnyTrace);
finally
if Not aSimulate then
EndProgress;
end;
if ConnFigures.Count > 0 then
begin
if Not aSimulate then
BeginProgress('', ConnFigures.Count);
try
for i := 0 to ConnFigures.Count - 1 do
begin
Conn1 := TConnectorObject(ConnFigures[i]);
Conn2 := FindNearObject(Conn1);
if Conn2 <> nil then
begin
Result := Result + 1;
if Not aSimulate then
begin
//Trace := CreateTraceByConnectors(CAD, Conn1, Conn2);
IsOrthoTrace := (Abs(Conn1.ActualPoints[1].x - Conn2.ActualPoints[1].x) > ptDelta) and (Abs(Conn1.ActualPoints[1].y - Conn2.ActualPoints[1].y) > ptDelta);
CreateTraceByConnectors(CAD, Conn1, Conn2, IsOrthoTrace);
end
else
begin
if aSimulateForAnyTrace then
Break; //// BREAK ////
end;
end;
if Not aSimulate then
StepProgress;
end;
finally
if Not aSimulate then
EndProgress;
end;
end;
ConnFigures.Free;
TraceList.Free;
end;
function AutoCreateTracesMaster(aSrcFigure: TFigure): Boolean;
var
Values: TStringList;
ValIdx: Integer;
viToMain: Integer;
viParallel: Integer;
viTree: Integer;
Traces: TList;
aDisableItem1: boolean;
begin
Result := false;
Traces := GetAllNoConnectedTraces(GCadForm);
Values := TStringList.Create;
viToMain := -1;
aDisableItem1 := True;
if Traces.Count > 0 then
begin
//viToMain := Values.Add(cCommon_Mes27_4); // Ïðîêëàäêà òðàññ ê ìàãèñòðàëè (îñíîâíîé òðàññå)
aDisableItem1 := False;
end;
viToMain := Values.Add(cCommon_Mes27_4); // Ïðîêëàäêà òðàññ ê ìàãèñòðàëè (îñíîâíîé òðàññå)
viParallel := Values.Add(cCommon_Mes27_3); // ïðîêëàäêà ïî òèïó çâåçäà (ïàðàëëåëüíàÿ)
viTree := Values.Add(cCommon_Mes27_2); // îáû÷íàÿ ïðîêëàäêà
PauseProgressByMode(true);
try
ValIdx := InputRadio(ApplicationName, cCommon_Mes27_1, nil{Values}, 0, aDisableItem1);
finally
PauseProgressByMode(false);
end;
if ValIdx <> -1 then
begin
Result := true;
if ValIdx = viToMain then
AutoCreateTracesToTraceList(Traces)
else if ValIdx = viParallel then
AutoCreateTracesParallel(aSrcFigure)
else if ValIdx = viTree then
AutoCreateTraces;
end;
Values.Free;
Traces.Free;
end;
function GetConnFiguresForAutoCreateTraces(aCad: TF_CAD; aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): TList;
var
i: Integer;
FFigure: TFigure;
Conn: TConnectorObject;
begin
Result := TList.Create;
// Ôîðìèðóåì ñïèñîê òî÷. îáúåêòîâ
for i := 0 to aCAD.PCad.FigureCount - 1 do
begin
FFigure := TFigure(aCAD.PCad.Figures[i]);
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
Conn := TConnectorObject(FFigure);
if (Conn.ConnectorType = ct_NB) and (Conn.FTrunkName = '') then
begin
if Conn.Selected or (aSimulate and aSimulateForAllObj) then
Result.Add(FFigure);
end;
end;
end;
end;
procedure DivideTracesOnRoowWalls(aCad: TF_CAD);
var
Figures: TList;
Cabinets: TList;
FFigure: TFigure;
Obj: TObject;
Trace: TOrtholine;
Cabinet: TCabinet;
CabinetExt: TCabinetExt;
Seg: TPLSegment;
PointCnt: Integer;
p1,p2: TDoublePoint;
i, j, k, SegNbr: Integer;
pArr: TDoublePointArr;
{procedure DivTraceOnPt(ATrace: TOrtholine; APt: TDoublePoint);
var
i: Integer;
NewConn: TConnectorObject;
begin
if Not (PointNear(ATrace.ActualPoints[1], APt) or PointNear(ATrace.ActualPoints[2], APt)) then
begin
NewConn := DivideLineSimple(ATrace, @APt);
for i := 0 to NewConn.JoinedOrtholinesList.Count - 1 do
begin
if TOrtholine(NewConn.JoinedOrtholinesList[i]) <> ATrace then
Figures.Add(TOrtholine(NewConn.JoinedOrtholinesList[i]));
end;
end;
end;}
procedure DivTraceOnCross(ATrace: TOrtholine; AP1, AP2: TDoublePoint);
var
p: TDoublePoint;
begin
if GetIntersectionPoint(ATrace.ActualPoints[1], ATrace.ActualPoints[2], AP1,AP2, p,false) then
DivTraceOnPt(ATrace, p, Figures);
//if Not (PointNear(ATrace.ActualPoints[1], p) or PointNear(ATrace.ActualPoints[2], p)) then
//begin
// NewConn := DivideLineSimple(ATrace, @p);
// AddTraceFromNewConn(NewConn, ATrace);
//end;
end;
procedure DivTraceOnArcCross(ATrace: TOrthoLine; ACenterPt, AP1: TDoublePoint; APolyLine: TPolyLine; ASeg: TPLSegment; ASegNbr: Integer);
var
rad: Double;
icnt: Integer;
np1,np2: TDoublePoint;
begin
rad := GetLineLenght(AP1, ACenterPt);
if GetLineCircleIntersection(ATrace.ActualPoints[1], ATrace.ActualPoints[2], ACenterPt, rad, np1,np2, icnt,false) then
begin
if iCnt > 0 then
begin
if APolyLine.isPointInSegment(ASegNbr,np1.x,np1.y) then
DivTraceOnPt(ATrace, np1, Figures);
end;
if iCnt > 1 then
begin
if APolyLine.isPointInSegment(ASegNbr,np2.x,np2.y) then
DivTraceOnPt(ATrace, np2, Figures);
end;
end;
end;
begin
Figures := TList.Create;
Cabinets := TList.Create;
for i := 0 to aCAD.PCad.FigureCount - 1 do
begin
FFigure := TFigure(aCAD.PCad.Figures[i]);
if CheckFigureByClassName(FFigure, cTOrtholine) then
begin
if FFigure.Selected then
Figures.Add(FFigure);
end
else if CheckFigureByClassName(FFigure, cTCabinet) then
begin
if TCabinet(Obj).FType <> ct_Virtual then
Cabinets.Add(FFigure);
end
else if CheckFigureByClassName(FFigure, cTCabinetExt) then
Cabinets.Add(FFigure);
end;
aCAD.SaveForUndo(uat_None, true, False);
if Cabinets.Count > 0 then
begin
BeginProgress;
try
i := 0;
while i < Figures.Count do
begin
Trace := TOrtholine(Figures[i]);
for j := 0 to Cabinets.Count - 1 do
begin
Obj := TObject(Cabinets[j]);
if Obj is TCabinet then
begin
Cabinet := TCabinet(Obj);
DivTraceOnCross(Trace, Cabinet.ap1, Cabinet.ap2);
DivTraceOnCross(Trace, Cabinet.ap2, Cabinet.ap3);
DivTraceOnCross(Trace, Cabinet.ap3, Cabinet.ap4);
DivTraceOnCross(Trace, Cabinet.ap4, Cabinet.ap1);
end
else
if Obj is TCabinetExt then
begin
CabinetExt := TCabinetExt(Obj);
SetLength(pArr, 0);
CabinetExt.GetLinearInterSections(Trace.ActualPoints[1], Trace.ActualPoints[2], pArr);
for k := 0 to Length(pArr) - 1 do
begin
if IsPointInLine(Trace.ActualPoints[1], Trace.ActualPoints[2], pArr[k], 1) then
DivTraceOnPt(Trace, pArr[k], Figures);
end;
SetLength(pArr, 0);
{PointCnt := CabinetExt.PointCount;
if Not CabinetExt.Closed then
PointCnt := CabinetExt.PointCount - 1;
for SegNbr := 1 to PointCnt do
begin
Seg := TPLSegment(CabinetExt.Segments[SegNbr-1]);
p1 := CabinetExt.actualpoints[SegNbr];
if SegNbr = PointCnt then
p2 := CabinetExt.actualpoints[1]
else
p2 := CabinetExt.actualpoints[SegNbr+1];
if Seg.SType = sLine then
DivTraceOnCross(Trace, p1, p2)
else if Seg.SType = sArc then
DivTraceOnArcCross(Trace, Seg.CPoint1, p1, CabinetExt, Seg, SegNbr);
end;}
end;
end;
i := i + 1;
end;
finally
EndProgress;
end;
end;
Cabinets.Free;
Figures.Free;
end;
procedure ApplySectionSideForTraces(aCad: TF_CAD);
var
Figures: TList;
FFigure: TFigure;
SCSList: TSCSList;
SCSObj: TSCSCatalog;
SCSCompon: TSCSComponent;
Trace: TOrtholine;
i, j: Integer;
SectSize, CompSectSize: Double;
begin
Figures := TList.Create;
for i := 0 to aCAD.PCad.FigureCount - 1 do
begin
FFigure := TFigure(aCAD.PCad.Figures[i]);
if CheckFigureByClassName(FFigure, cTOrtholine) then
if FFigure.Selected then
Figures.Add(FFigure);
end;
if Figures.Count > 0 then
begin
aCAD.SaveForUndo(uat_None, true, False);
BeginProgress;
try
SCSList := GetSCSListByCAD(aCad);
for i := 0 to Figures.Count - 1 do
begin
Trace := TOrtholine(Figures[i]);
SCSObj := SCSList.GetCatalogFromReferencesBySCSID(Trace.ID);
if SCSObj <> nil then
begin
SectSize := 0;
for j := 0 to SCSObj.ComponentReferences.Count - 1 do
begin
SCSCompon := SCSObj.ComponentReferences[j];
if CheckSysNameIsCableChannel(SCSCompon.ComponentType.SysName) then
begin
CompSectSize := SCSCompon.GetPropertyValueAsFloat(pnSectionSize);
if CompSectSize > 0 then
if (SectSize = 0) OR (CompSectSize < SectSize) then
SectSize := CompSectSize;
end;
end;
if SectSize > 0 then
aCad.AutoDivideTraceOnAppendCable(Trace, SectSize);
end;
end;
finally
EndProgress;
end;
end;
Figures.Free;
end;
procedure SetConnComponToTraces(aCad: TF_CAD; ACompon: TSCSComponent; AStep: Double; ASetToConnectors: Boolean);
var
Figures: TList;
AccessibleTraces: TList;
FFigure: TFigure;
StepPC: Double;
i: Integer;
Trace: TOrthoLine;
StartConn: TConnectorObject;
StepFigures: TList;
LookedFigures: TList;
// Ñðàâíåíèå òðàññ êàêàÿ áëèæå ê íà÷àëó êîîðäèíàò
function TracesCompare(Item1, Item2: Pointer): Integer;
var
dist11, dist12, dist21, dist22: Double;
dist1, dist2: Double;
begin
dist11 := GetLineLenght(TOrthoLine(Item1).ActualPoints[1], DoublePoint(0,0));
dist12 := GetLineLenght(TOrthoLine(Item1).ActualPoints[2], DoublePoint(0,0));
dist21 := GetLineLenght(TOrthoLine(Item2).ActualPoints[1], DoublePoint(0,0));
dist22 := GetLineLenght(TOrthoLine(Item2).ActualPoints[2], DoublePoint(0,0));
dist1 := Min(dist11, dist12);
dist2 := Min(dist21, dist22);
Result := 0;
if dist1 < dist2 then
Result := -1
else
if dist1 > dist2 then
Result := 1;
end;
function SetComponsToTrace(ATrace: TOrthoLine; ASetToStartPt: Boolean; AStartPt, AEndPt: TDoublePoint; var ALastPt: TDoublePoint): Boolean;
var
ComponCount: Integer;
TraceLen: Double;
i, j: Integer;
Traces: TList;
Trace: TOrthoLine;
Conn: TConnectorObject;
NextPt, TmpPt: TDoublePoint;
TmpLen: Double;
begin
Result := false;
TraceLen := GetLineLenght(AStartPt, AEndPt);
ComponCount := Trunc(TraceLen / StepPC);
if ComponCount > 0 then
begin
Traces := TList.Create;
Traces.Add(ATrace);
//i := 1;
//if ASetToStartPt then
// i := 0;
i := 0;
NextPt := AStartPt;
// Åñëè íå óñòàíàâëèâàòü â ñòàðòîâóþ òî÷êó
if Not ASetToStartPt then
begin
i := 1;
NextPt := MPoint(AStartPt, AEndPt, StepPC);
end;
while i <= ComponCount do
begin
//NextPt := MPoint(AStartPt, AEndPt, StepPC * i);
for j := 0 to Traces.Count - 1 do
begin
Trace := TOrthoLine(Traces[j]);
Conn := nil;
if IsPointInLine(Trace.ActualPoints[1], Trace.ActualPoints[2], NextPt, 1) then
Conn := DivTraceOnPt(Trace, NextPt, Traces);
// Óñòàíàâëèâàåì êîìïîíåíò â íîâûé ñîåäèíèòåëü
if Conn <> nil then
begin
NextPt := Conn.ActualPoints[1]; // Íà ñîçäàíèè ñîåäèíèòåëÿ ì.á. íåáîëüøîå ñìåùåíèå
CopyComponentToSCSObject(Conn.ID, ACompon.ID);
if Conn.JoinedConnectorsList.Count > 0 then
NextPt := TConnectorObject(Conn.JoinedConnectorsList[0]).ActualPoints[1];
ALastPt := NextPt;
Result := true;
TmpPt := MPoint(NextPt, AEndPt, StepPC);
TmpLen := GetLineLenght(NextPt, TmpPt);
NextPt := TmpPt;
end;
end;
i := i + 1;
end;
// Ó÷èòûâàåì íîâûå ðàçäåëåííûå òðàññû â ñïèñîê äîñòóïíûõ
AccessibleTraces.Assign(Traces, laOr);
Traces.Free;
end;
end;
// AStartConn - ñîåäèíèòåëü òðàññû ñ êîðîòîãî ñìîòðèì
// AStartPt - íà áóäóùåå - ñòàðòîâàÿ òî÷êà ñ êîòîðîé ñìîòðèì - åñëè óñòàíàâëèâàåì ÷åðåç ïóñòûå ñîåäèíèòåëè
procedure Step(ATrace: TOrthoLine; AStartConn: TConnectorObject; AStartPtOffset: Double=0; AStepIndex: Integer=0);
var
//TraceLen: Double;
EndConn: TConnectorObject;
JoinedTraces: TList;
Trace: TOrthoLine;
i: Integer;
StartPt, EndPt, LastPt: TDoublePoint;
SetToStartPt: Boolean;
NextTracePtOffset: Double; // Ñìåùåíèå ñòàðòîâîé òî÷êè ñëåäóþùåé òðàññû
begin
if (LookedFigures.IndexOf(ATrace) = -1) and (AccessibleTraces.IndexOf(ATrace) <> -1) then
begin
StepFigures.Add(ATrace);
LookedFigures.Add(ATrace);
EndConn := nil;
if ATrace.JoinConnector1 = AStartConn then
EndConn := TConnectorObject(ATrace.JoinConnector2)
else if ATrace.JoinConnector2 = AStartConn then
EndConn := TConnectorObject(ATrace.JoinConnector1);
if EndConn <> nil then
begin
NextTracePtOffset := 0;
SetToStartPt := false;
StartPt := AStartConn.ActualPoints[1];
EndPt := EndConn.ActualPoints[1];
if AStartPtOffset <> 0 then
StartPt := MPoint(StartPt, EndPt, AStartPtOffset);
if LookedFigures.IndexOf(AStartConn) = -1 then
begin
// Óñòàíàâëèâàåì â ñîåäèíèòåëü
if ASetToConnectors then
CopyComponentToSCSObject(AStartConn.ID, ACompon.ID);
LookedFigures.Add(AStartConn);
end;
if Not ASetToConnectors then
begin
// Åñëè ïî ñìåùåíèþ ïîïàäàåì íå íà ñîåäèíèòåëü
if Not PointNear(StartPt, AStartConn.ActualPoints[1]) then
SetToStartPt := true;
end;
if SetComponsToTrace(ATrace, SetToStartPt, StartPt, EndPt, LastPt) then
begin
// Åñëè íå óñòàíàâëèâàåì íà ñîåäèíèòåëè, âû÷èñëÿåì ñìåùåíèå îò íà÷àëüíîé òî÷êè äëÿ ñëåäóþùèõ òðàññ
if Not ASetToConnectors then
begin
NextTracePtOffset := StepPC - GetLineLenght(LastPt, EndPt);
if NextTracePtOffset < 0 then
NextTracePtOffset := 0;
end;
end;
LookedFigures.Add(EndConn);
if ASetToConnectors then
begin
// Óñòàíàâëèâàåì â ñîåäèíèòåëü
CopyComponentToSCSObject(EndConn.ID, ACompon.ID);
end;
// îò ñîåäèíèòåëÿ èùåì äðóãèå òðàññû
JoinedTraces := GetAllConnectedTraces(EndConn);
for i := 0 to JoinedTraces.Count - 1 do
begin
Trace := TOrthoLine(JoinedTraces[i]);
Step(Trace, EndConn, NextTracePtOffset, AStepIndex+1);
end;
JoinedTraces.Free;
end;
StepFigures.Delete(StepFigures.Count-1);
end;
end;
begin
Figures := TList.Create;
for i := 0 to aCAD.PCad.FigureCount - 1 do
begin
FFigure := TFigure(aCAD.PCad.Figures[i]);
if CheckFigureByClassName(FFigure, cTOrtholine) then
begin
if FFigure.Selected then
Figures.Add(FFigure);
end;
end;
aCAD.SaveForUndo(uat_None, true, False);
if Figures.Count > 0 then
begin
BeginProgress;
try
StepPC := AStep * (1000/ aCAD.PCad.MapScale);
AccessibleTraces := TList.Create;
AccessibleTraces.Assign(Figures);
LookedFigures := TList.Create;
StepFigures := TList.Create;
// Ñîðòèðóåì òðàññû
Figures.Sort(@TracesCompare);
for i := 0 to Figures.Count - 1 do
begin
Trace := TOrthoLine(Figures[i]);
StartConn := GetMinConnector(TConnectorObject(Trace.JoinConnector1), TConnectorObject(Trace.JoinConnector2));
Step(Trace, StartConn);
end;
finally
StepFigures.Free;
LookedFigures.Free;
AccessibleTraces.Free;
EndProgress;
end;
end;
Figures.Free;
end;
procedure MirrorFigure(AFigure: TFigure);
begin
AFigure.Mirror(AFigure.CenterPoint, AFigure.CenterPoint);
end;
procedure MoveFigures(AFigures: TList; x, y: Double);
var
i: integer;
Figure: TFigure;
SavedMoveAllPoints: Boolean;
Path: TNetPath;
begin
for i := 0 to AFigures.Count - 1 do
begin
Figure := TFigure(AFigures[i]);
if Figure is TNet then
begin
if ssCtrl in GGlobalShiftState then
begin
Path := TNet(Figure).SelPath;
if Path <> nil then
begin
Path.FPointsOffset := Path.FPointsOffset + (x+y);
TNet(Figure).RefreshPaths;
end;
Continue; //// CONTINUE ////
end;
SavedMoveAllPoints := TNet(Figure).FMoveAllPoints;
TNet(Figure).FMoveAllPoints := true;
end;
Figure.Move(x, y);
if Figure is TNet then
TNet(Figure).FMoveAllPoints := SavedMoveAllPoints;
end;
end;
procedure RotateFigure(AFigure: TFigure; Angle: Double);
var
AngleRad: Double;
AngleDeg: Double;
Bnd: TDoubleRect;
pt: TDoublePoint;
begin
AngleRad := Angle / 180 * pi;
//if Not (AFigure is TNet) then
// pt := AFigure.ActualPoints[1]
//else if TNet(AFigure).Points.Count > 0 then
// pt := PDoublePoint(TNet(AFigure).Points[0])^
//else
// pt := DoublePoint(0, 0);
Bnd := AFigure.GetBoundRect;
//pt := DoublePoint((figMaxX+figMinX)/2,(figMaxY+figMinY)/2);
pt := DoublePoint((Bnd.Left + Bnd.Right)/2, (Bnd.Top + Bnd.Bottom)/2);
AFigure.Rotate(AngleRad, pt);
//AFigure.DrawFigure.Rotate(AngleRad, AFigure.CenterPoint);
//AFigure.FDrawFigureAngle := AFigure.FDrawFigureAngle + AngleRad;
//if AFigure.FDrawFigureAngle >= 2 * pi then
// AFigure.FDrawFigureAngle := AFigure.FDrawFigureAngle - 2 * pi;
//Bnd := AFigure.DrawFigure.GetBoundRect;
//AFigure.GrpSizeX := Bnd.Right - Bnd.Left;
//AFigure.GrpSizeY := Bnd.Bottom - Bnd.Top;
RefreshCAD(GCadForm.PCad);
end;
procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor);
type
TRGB = record
B, G, R: Byte;
end;
pRGB = ^TRGB;
pByteArray = ^TByteArray;
TByteArray = array[0..32767] of Byte;
TRectList = array[1..4] of TPoint;
var
x, y, W, H, v1, v2: Integer;
Dest, Src: pRGB;
VertArray: array of pByteArray;
Bmp: TBitmap;
procedure SinCos(AngleRad: Double; var ASin, ACos: Double);
begin
ASin := Sin(AngleRad);
ACos := Cos(AngleRad);
end;
function RotateRect(const Rect: TRect; const Center: TPoint; Angle: Double):
TRectList;
var
DX, DY: Integer;
SinAng, CosAng: Double;
function RotPoint(PX, PY: Integer): TPoint;
begin
DX := PX - Center.x;
DY := PY - Center.y;
Result.x := Center.x + Round(DX * CosAng - DY * SinAng);
Result.y := Center.y + Round(DX * SinAng + DY * CosAng);
end;
begin
SinCos(Angle * (Pi / 180), SinAng, CosAng);
Result[1] := RotPoint(Rect.Left, Rect.Top);
Result[2] := RotPoint(Rect.Right, Rect.Top);
Result[3] := RotPoint(Rect.Right, Rect.Bottom);
Result[4] := RotPoint(Rect.Left, Rect.Bottom);
end;
function Min(A, B: Integer): Integer;
begin
if A < B then
Result := A
else
Result := B;
end;
function Max(A, B: Integer): Integer;
begin
if A > B then
Result := A
else
Result := B;
end;
function GetRLLimit(const RL: TRectList): TRect;
begin
Result.Left := Min(Min(RL[1].x, RL[2].x), Min(RL[3].x, RL[4].x));
Result.Top := Min(Min(RL[1].y, RL[2].y), Min(RL[3].y, RL[4].y));
Result.Right := Max(Max(RL[1].x, RL[2].x), Max(RL[3].x, RL[4].x));
Result.Bottom := Max(Max(RL[1].y, RL[2].y), Max(RL[3].y, RL[4].y));
end;
procedure Rotate;
var
x, y, xr, yr, yp: Integer;
ACos, ASin: Double;
Lim: TRect;
begin
W := Bmp.Width;
H := Bmp.Height;
SinCos(-Angle * Pi / 180, ASin, ACos);
Lim := GetRLLimit(RotateRect(Rect(0, 0, Bmp.Width, Bmp.Height), Point(0, 0),
Angle));
Bitmap.Width := Lim.Right - Lim.Left;
Bitmap.Height := Lim.Bottom - Lim.Top;
Bitmap.Canvas.Brush.Color := BackColor;
Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
for y := 0 to Bitmap.Height - 1 do
begin
Dest := Bitmap.ScanLine[y];
yp := y + Lim.Top;
for x := 0 to Bitmap.Width - 1 do
begin
xr := Round(((x + Lim.Left) * ACos) - (yp * ASin));
yr := Round(((x + Lim.Left) * ASin) + (yp * ACos));
if (xr > -1) and (xr < W) and (yr > -1) and (yr < H) then
begin
Src := Bmp.ScanLine[yr];
Inc(Src, xr);
Dest^ := Src^;
end;
Inc(Dest);
end;
end;
end;
begin
Bitmap.PixelFormat := pf16Bit;
Bmp := TBitmap.Create;
try
Bmp.Assign(Bitmap);
W := Bitmap.Width - 1;
H := Bitmap.Height - 1;
if Frac(Angle) <> 0.0 then
Rotate
else
case Trunc(Angle) of
-360, 0, 360, 720: Exit;
90, 270:
begin
Bitmap.Width := H + 1;
Bitmap.Height := W + 1;
SetLength(VertArray, H + 1);
v1 := 0;
v2 := 0;
if Angle = 90.0 then
v1 := H
else
v2 := W;
for y := 0 to H do
VertArray[y] := Bmp.ScanLine[Abs(v1 - y)];
for x := 0 to W do
begin
Dest := Bitmap.ScanLine[x];
for y := 0 to H do
begin
v1 := Abs(v2 - x) * 3;
with Dest^ do
begin
B := VertArray[y, v1];
G := VertArray[y, v1 + 1];
R := VertArray[y, v1 + 2];
end;
Inc(Dest);
end;
end
end;
180:
begin
for y := 0 to H do
begin
Dest := Bitmap.ScanLine[y];
Src := Bmp.ScanLine[H - y];
Inc(Src, W);
for x := 0 to W do
begin
Dest^ := Src^;
Dec(Src);
Inc(Dest);
end;
end;
end;
else
Rotate;
end;
finally
Bmp.Free;
end;
end;
function GetArcLen(Radius, RadAngle: Double): Double;
begin
// Äëèíà äóãè ðàäèóñà R ñ ðàäèàííîé ìåðîé a, ðàâíà R*a
// ×åðåç ãðàäóñíóþ ìåðó n äëèíà äóãè âûðàæàåòñÿ ôîðìóëîé (pi * R * n)/180
Result := Radius * RadAngle;
end;
function GetArcLen(CenterPoint, LinePoint: TDoublePoint; RadAngle: Double): Double;
begin
Result := GetLineLenght(CenterPoint, LinePoint) * RadAngle;
end;
function GetArcLenByPoints(p1, p2, ArcCenter: TDoublePoint; AInverted: Boolean): Double;
var
PointsAng: Double;
begin
PointsAng := 0;
if AInverted then
PointsAng := GetRadOf2Lines(p1, ArcCenter, p2)
else
PointsAng := GetRadOf2Lines(p2, ArcCenter, p1);
if PointsAng = 0 then
PointsAng := 2 * pi
else
if PointsAng < 0 then
PointsAng := (2 * pi) + PointsAng;
Result := GetArcLen(ArcCenter, p1, PointsAng);
end;
function GetPolylineFromArc(ACornerCount: Integer; cp:TdoublePoint; radius, ArcAng: Double; p1, p2: PDoublePoint): TDoublePointArr;
var
AngleStep: Double;
pt, StartPt: TDoublePoint;
i: Integer;
{function ChoicePtByAngle(Ang: Double): Boolean;
begin
Result := false;
pt := p1^;
TempPt := GetRelativePointbyAngleFloat(ArcAng, cp, pt);
if EQDP(pt, p2^) then
pt := p1^
else
pt := p2^;
end;}
begin
SetLength(Result, 0);
AngleStep := ArcAng / ACornerCount;
for i := 0 to ACornerCount - 1 do
begin
if i = 0 then
begin
if (p1 <> nil) or (p2 <> nil) then
begin
if (p1 <> nil) and (p2 <> nil) then
begin
{if Not AInverted then
begin
if GetRadOfLine(cp, p1^) > GetRadOfLine(cp, p2^) then
pt := p2^
else
pt := p1^;
end
else
begin
if GetRadOfLine(cp, p1^) < GetRadOfLine(cp, p2^) then
pt := p2^
else
pt := p1^;
end;}
pt := p1^;
pt := GetRelativePointbyAngleFloat(ArcAng, cp, pt);
if PointNear(pt, p2^, 1) then //if EQDP(pt, p2^) then
pt := p1^
else
pt := p2^;
end
else if (p1 <> nil) and (ArcAng = 360) then
pt := p1^;
StartPt := pt;
end
else
begin
pt := cp;
pt.y := pt.y - radius;
end;
end
else
//15.09.2011 pt := GetRelativePointbyAngleFloat(AngleStep, cp, pt);
pt := GetRelativePointbyAngleFloat(AngleStep * i, cp, StartPt);
SetLength(Result, Length(Result)+1);
Result[i] := pt;
end;
end;
function GetLinesAngle(AP1, AP2, AP3, AP4: TDoublePoint): Double;
begin
// Êîîðäèíàòû îòðåçêîâ çàäàíû òî÷êàìè (x1,y1)-(x2,y2) (x3,y3)-(x4,y4)
// a = arctg[(y2 - y1)/(x2 - x1)] - arctg[(y4 - y3)/(x4 - x3)]
Result := ArcTanh((AP2.y - AP1.y)/(AP2.x - AP1.x)) - ArcTanh((AP4.y - AP3.y)/(AP4.x - AP3.x));
end;
function GetAreaFromPolygon3D(APoints: PDoublePointArr): Double;
var
IsResult: Boolean;
begin
Result := 0;
IsResult := false;
if Length(APoints^) > 2 then
begin
if EQDP(APoints^[0], APoints^[Length(APoints^)-1]) then
begin
// Òðåóãîëüíèê
if Length(APoints^) = 4 then
begin
Result := Result + GetTriangleArea3D(APoints^[0], APoints^[1], APoints^[2]);
IsResult := true;
end
else
// Òðàïåöèÿ
if Length(APoints^) = 5 then
begin
Result := Result + GetTriangleArea3D(APoints^[0], APoints^[1], APoints^[2])+
GetTriangleArea3D(APoints^[2], APoints^[3], APoints^[0]);
IsResult := true;
end
else
// 5-òè óãîëüíèê
if Length(APoints^) = 6 then
begin
Result := Result + GetTriangleArea3D(APoints^[0], APoints^[1], APoints^[2])+
GetTriangleArea3D(APoints^[2], APoints^[3], APoints^[4])+
GetTriangleArea3D(APoints^[2], APoints^[4], APoints^[0]);
IsResult := true;
end
else
// 6-òè óãîëüíèê
if Length(APoints^) = 7 then
begin
Result := Result + GetTriangleArea3D(APoints^[0], APoints^[1], APoints^[2])+
GetTriangleArea3D(APoints^[2], APoints^[3], APoints^[4])+
GetTriangleArea3D(APoints^[4], APoints^[5], APoints^[0])+
// âíóòð-òðèóãîëüíèê
GetTriangleArea3D(APoints^[0], APoints^[2], APoints^[4]);
IsResult := true;
end
else
// 7-òè óãîëüíèê
if Length(APoints^) = 8 then
begin
Result := Result + GetTriangleArea3D(APoints^[0], APoints^[1], APoints^[2])+
GetTriangleArea3D(APoints^[2], APoints^[3], APoints^[4])+
GetTriangleArea3D(APoints^[4], APoints^[5], APoints^[6])+
GetTriangleArea3D(APoints^[6], APoints^[7], APoints^[0])+
// âíóòð-òðèóãîëüíèê
GetTriangleArea3D(APoints^[0], APoints^[2], APoints^[4])+
GetTriangleArea3D(APoints^[4], APoints^[6], APoints^[0]);
IsResult := true;
end;
end;
end;
if Not IsResult then
Result := GetAreaFromPolygon(APoints^);
end;
function GetPerimetrFromPolygon(APoints: PDoublePointArr): Double;
var
i: Integer;
p1, p2: PDoublePoint;
begin
Result := 0;
for i := 1 to Length(APoints^) do
Result := Result + GetLineLenght(APoints^[i-1], APoints^[i]);
end;
procedure GetLinesNearPoints(ap1, ap2, bp1, bp2: PDoublePoint; var ap, bp: TDoublePoint);
var
APoints, BPoints: TList;
i, j: Integer;
LastDist, Dist: Double;
begin
ap := Doublepoint(0,0,0);
bp := Doublepoint(0,0,0);
APoints := TList.Create;
APoints.Add(ap1);
APoints.Add(ap2);
BPoints := TList.Create;
BPoints.Add(bp1);
BPoints.Add(bp2);
LastDist := -1;
for i := 0 to APoints.Count - 1 do
begin
for j := 0 to BPoints.Count - 1 do
begin
Dist := GetLineLength(PDoublePoint(APoints[i])^, PDoublePoint(BPoints[j])^);
if (LastDist = -1) or (Dist < LastDist) then
begin
LastDist := Dist;
ap := PDoublePoint(APoints[i])^;
bp := PDoublePoint(BPoints[j])^;
end;
end;
end;
APoints.Free;
BPoints.Free;
end;
function IsConvexPolygon(APoints: PDoublePointArr; ALastPtInFirst: Boolean): Integer;
// http://algolist.manual.ru/maths/geom/polygon/convex_or.php
// Äëÿ âûïóêëîãî ìíîãîóãîëüíèêà âñå âåêòîðíûå ïðîèçâåäåíèÿ ñìåæíûõ ñòîðîí áóäóò îäèíàêîâîãî çíàêà,
// à åñëè ýòî íå òàê, òî áóäåò ïðèñóòñòâîâàòü è ïðîèçâåäåíèå ïðîòèâîïîëîæíîãî çíàêà.
var
i,j,k: Integer;
flag: Integer;
z: Double;
PtCount: Integer;
begin
Result := pltNone;
PtCount := Length(APoints^);
if ALastPtInFirst then
PtCount := PtCount - 1;
if PtCount > 2 then
begin
flag := 0;
for i := 0 to PtCount - 1 do
begin
j := (i + 1) mod PtCount;
k := (i + 2) mod PtCount;
z := (APoints^[j].x - APoints^[i].x) * (APoints^[k].y - APoints^[j].y);
z := z - (APoints^[j].y - APoints^[i].y) * (APoints^[k].x - APoints^[j].x);
if z < 0 then
flag := flag or 1
else if z > 0 then
flag := flag or 2;
if flag = 3 then
begin
Result := pltConcave; // âîãíóòûé
Exit; ///// EXIT /////
//Break; //// BREAK ////
end;
end;
if flag <> 0 then
Result := pltConvex // âûïóêëûé
else
Result := pltNone;
end;
end;
function OverlapDoubleRects(const R1, R2: TDoubleRect): Boolean;
begin
Result := False;
// Åñëè R1.Left èëè R1.Right ìåæäó R2.Left è R2.Right (Ïðîâåðêà ïî ãîðèçîíòàëè)
if ((R1.Left >= R2.Left) and (R1.Left <= R2.Right)) or ((R1.Right >= R2.Left) and (R1.Right <= R2.Right)) then
begin
// Åñëè R1.Top èëè R1.Bottom ìåæäó R2.Top è R2.Bottom (Ïðîâåðêà ïî Âåðòèêàëè)
if ((R1.Top >= R2.Top) and (R1.Top <= R2.Bottom)) or ((R1.Bottom >= R2.Top) and (R1.Bottom <= R2.Bottom)) then
Result := True
else
// Åñëè R2.Top èëè R2.Bottom ìåæäó R1.Top è R1.Bottom (Ïðîâåðêà ïî Âåðòèêàëè)
if ((R2.Top >= R1.Top) and (R2.Top <= R1.Bottom)) or ((R2.Bottom >= R1.Top) and (R2.Bottom <= R1.Bottom)) then
Result := True;
end
else
// Åñëè R2.Left èëè R2.Right ìåæäó R1.Left è R1.Right (Ïðîâåðêà ïî ãîðèçîíòàëè)
if ((R2.Left >= R1.Left) and (R2.Left <= R1.Right)) or ((R2.Right >= R1.Left) and (R2.Right <= R1.Right)) then
begin
// Åñëè R1.Top èëè R1.Bottom ìåæäó R2.Top è R2.Bottom (Ïðîâåðêà ïî Âåðòèêàëè)
if ((R1.Top >= R2.Top) and (R1.Top <= R2.Bottom)) or ((R1.Bottom >= R2.Top) and (R1.Bottom <= R2.Bottom)) then
Result := True
else
// Åñëè R2.Top èëè R2.Bottom ìåæäó R1.Top è R1.Bottom (Ïðîâåðêà ïî Âåðòèêàëè)
if ((R2.Top >= R1.Top) and (R2.Top <= R1.Bottom)) or ((R2.Bottom >= R1.Top) and (R2.Bottom <= R1.Bottom)) then
Result := True;
end;
end;
function CorrectAngle(aAngle: Double; AStep: Integer=360): Double;
begin
Result := aAngle;
while Result > AStep do
Result := Result - AStep;
while Result < 0 do
Result := Result + AStep;
end;
function GetTextHeight(FontHandle: HWND; AFont: TFont): Double;
var
DC: HDC;
{SaveFont: HFONT;
TTM: TTextMetric;
StrHgt:integer;}
mRes: Boolean;
LogFnt : TLogFont;
oldFont,newFont : HFont;
IsTrueTypeFont : Boolean;
fFontStyle : TFontStyles;
fFontName : TFontName;
fFontColor : TColor;
Metrics: TTextMetric;
begin
Result := 0;
{DC := GetDC(0);
if (DC <> 0) then
begin
SaveFont := SelectObject(DC, FontHandle);
mRes := GetTextMetrics(DC,TTM);
if (mRes) then
StrHgt:=TTM.tmHeight+TTM.tmExternalLeading;
SelectObject(DC, SaveFont);
ReleaseDC(0,DC);
Result := StrHgt;
end;}
LogFnt.lfHeight := AFont.Height; //10;
LogFnt.lfWidth := 10;
LogFnt.lfEscapement := 0;
LogFnt.lfWeight := FW_REGULAR;
LogFnt.lfItalic := 0;
LogFnt.lfUnderline := 0;
LogFnt.lfStrikeOut := 0;
LogFnt.lfCharSet := DEFAULT_CHARSET;
LogFnt.lfOutPrecision := OUT_DEFAULT_PRECIS;
LogFnt.lfClipPrecision := CLIP_DEFAULT_PRECIS;
LogFnt.lfQuality := DEFAULT_QUALITY;
LogFnt.lfPitchAndFamily := DEFAULT_PITCH or FF_DONTCARE;
StrPCopy(LogFnt.lfFaceName, AFont.Name);
//StrPCopy(LogFnt.lfFaceName, 'Arial');
newFont := CreateFontIndirect(LogFnt);
DC := GetDC(0);
if DC <> 0 then
begin
oldFont := SelectObject(DC,newFont);
ZeroMemory(@Metrics, SizeOf(Metrics));
mRes := GetTextMetrics(DC, Metrics);
if mRes then
Result := Metrics.tmHeight;
SelectObject(DC,oldFont);
ReleaseDC(0,DC);
end;
end;
procedure GetTextSize(AFontSize: Integer; AStyles: TFontStyles; const AFontName, AText: String; AStrings: TStrings;
var h, w: Double; AStrH: Pointer=nil);
var
tmpCanvas: TCanvas;
i: Integer;
Str: String;
DefinedH: Boolean;
tw: Integer;
Strings: TStrings;
begin
h := 0;
w := 0;
if AStrH <> nil then
Integer(AStrH^) := 0;
Strings := TStringList.Create;
if (AStrings = nil) and (AText <> '') then
begin
Strings.Text := AText;
end
else
if (assigned(AStrings)) then
Strings.Text := AStrings.Text;
if Strings <> nil then
begin
tmpCanvas := TCanvas.Create;
tmpCanvas.Handle := GetDC(0);
if tmpCanvas.Handle <> 0 then
begin
tmpCanvas.Font.Name := AFontName;
tmpCanvas.Font.Size := AFontSize;
tmpCanvas.Font.Style := AStyles;
//h := tmpCanvas.TextHeight('W');
//w := tmpCanvas.TextWidth('W');
DefinedH := false;
for i := 0 to Strings.Count - 1 do
begin
Str := Strings[i];
if Not DefinedH and (Str <> '') then
begin
h := tmpCanvas.TextHeight(Str);
// Åñëè íå óäàëîñü îïðåäåëèòü âûñîòó ñ ýòèì øðèôòîì, òî ïðîáóåì äëÿ Arial
if h = 0 then
begin
tmpCanvas.Font.Name := 'Arial';
h := tmpCanvas.TextHeight(Str);
end;
DefinedH := true;
if AStrH <> nil then
Integer(AStrH^) := Trunc(h);
end;
tw := tmpCanvas.TextWidth(Str);
if tw > w then
w := tw;
end;
ReleaseDC(0,tmpCanvas.Handle);
end;
tmpCanvas.Free;
h := h / 4 * Strings.Count + 1;
w := (w + 3) / 4;
if Strings = nil then
Strings.Free;
end;
end;
function DefineFrameByPrinter(aRect: TDoubleRect): TDoubleRect;
var
PSD: TPrinterSetupDialog;
DPIX: double;
DPIY: double;
OFFX: double;
OFFY: double;
OFFMMX: double;
OFFMMY: double;
begin
Result := aRect;
PSD := TPrinterSetupDialog.Create(nil);
try
if PSD.Execute then
begin
if (Printer <> nil) then
begin
DPIX := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
DPIY := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
OFFX := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
OFFY := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
OFFMMX := (OFFX / DPIX) * 25.4;
OFFMMY := (OFFY / DPIY) * 25.4;
Result.Top := Round3(aRect.Top - OFFMMY);
if Result.Top < 0 then
Result.Top := 1;
// Ó÷èòûâàåì ÷òî ñëåâà ñìåùåíèå íå ñäåëàíî
// OFFMMX * 2 = ïîä êðàé ïå÷àòàåìîé îáëàñòè ñïðàâà
Result.Right := Round3(OFFMMX * 2 + (aRect.Right - OFFMMX));
if Result.Right < 0 then
Result.Right := 1;
Result.Bottom := Round3(OFFMMY * 2 + (aRect.Bottom - OFFMMY));
if Result.Bottom < 0 then
Result.Bottom := 1;
end;
end;
finally
PSD.Free;
end;
end;
function GetMultipleFromNB:Boolean; //From Dimon ;)
var
Side1,Side2: String;
CurrDat: PObjectData;
SCSComponInNormBase: TSCSComponent;
j: integer;
begin
Result := false;
SCSComponInNormBase := nil;
CurrDat := F_NormBase.Tree_Catalog.selected.data;
if CurrDat <> nil then
if (CurrDat.ItemType in [itComponLine, itComponCon, itArhRoofSeg, itArhRoofHip, itArhRoofHipCorner]) then
begin
if SCSComponInNormBase = nil then
begin
SCSComponInNormBase := TSCSComponent.Create(F_NormBase); //Ñîçäàíèå íîâîãî êîìïîíà
end;
SCSComponInNormBase.Clear;
begin
SCSComponInNormBase.Clear;
SCSComponInNormBase.LoadComponentByID(CurrDat.ObjectID, true, true, false);//Çàãðóæàåì åãî èíòåðôåéñû.À áîëüøå íè÷åãî è íå íóæíî
end;
end;
for j := 0 to SCSComponInNormBase.Interfaces.Count - 1 do
begin
if TSCSInterface(SCSComponInNormBase.Interfaces[j]).TypeI = itFunctional then
begin
//Òàê êàê ó ôóíêöèîíàëüíûõ îíòåðôåéñîâ SideSection îäèíàêîâûé çàïîìèíàåì ïåðâûé ïîïàâøèéñÿ
Result := Boolean(TSCSInterface(SCSComponInNormBase.Interfaces[j]).Multiple);
break;
end;
end;
SCSComponInNormBase.Clear;
FreeAndNil(SCSComponInNormBase);
end;
//Ôóíêöèÿ ñðàâíèâàåò ïàðàìåòðû âûáðàííîãî êîìïîíåíòà èç äåðåâà ñ òåì, ÷òî óæå èìååòñÿ íà êàäå
Function CheckComponentsForSideSection(CurrCompon: TSCSComponent):Boolean; //From Dimon ;)
var
Side1,Side2: String;
CurrDat: PObjectData;
SCSComponInNormBase: TSCSComponent;
j: integer;
begin
Result := false;
SCSComponInNormBase := nil;
CurrDat := F_NormBase.Tree_Catalog.selected.data;
if CurrDat <> nil then
if (CurrDat.ItemType in [itComponLine, itComponCon, itArhRoofSeg, itArhRoofHip, itArhRoofHipCorner]) then
begin
if SCSComponInNormBase = nil then
begin
SCSComponInNormBase := TSCSComponent.Create(F_NormBase); //Ñîçäàíèå íîâîãî êîìïîíà
end;
SCSComponInNormBase.Clear;
begin
SCSComponInNormBase.Clear;
SCSComponInNormBase.LoadComponentByID(CurrDat.ObjectID, true, true, false);//Çàãðóæàåì åãî èíòåðôåéñû.À áîëüøå íè÷åãî è íå íóæíî
end;
end;
for j := 0 to SCSComponInNormBase.Interfaces.Count - 1 do
begin
if TSCSInterface(SCSComponInNormBase.Interfaces[j]).TypeI = itFunctional then
begin
//Òàê êàê ó ôóíêöèîíàëüíûõ îíòåðôåéñîâ SideSection îäèíàêîâûé çàïîìèíàåì ïåðâûé ïîïàâøèéñÿ
Side1 := TSCSInterface(SCSComponInNormBase.Interfaces[j]).SideSection;
break;
end;
end;
for j := 0 to CurrCompon.Interfaces.Count - 1 do
begin
//Òî æå ñàìîå ñ ïðîâåðÿåìûì êîìïîíîì
if TSCSInterface(CurrCompon.Interfaces[j]).TypeI = itFunctional then
begin
Side2 := TSCSInterface(CurrCompon.Interfaces[j]).SideSection;
break;
end;
end;
SCSComponInNormBase.Clear;
FreeAndNil(SCSComponInNormBase);
//Ñâåðÿåì åñëè îäèíàêîâûå, ìîæíî äåëàòü ðàçëè÷íûå ìàõèíàöèè
if Side1 = Side2 then
result := true;
end;
// TODO 5: Ïåðåñìîòðåòü ãäå Figures.count èñïîëüçóåòñÿ ÷åðåç for â äâèæêå PowerCAD è ïî âîçìîæíîñòè þçàòü for
// TODO 6: Ó÷åñòü ñîðò ñïèñîê íà undo/redo, êîïèðîâàíèè ëèñòà, äóáëèðîâàíèè îáúåêòîâ
end.