admin/expertcad
1
0
Fork 0
mirror of http://gitlab.expertsoft.com.ua/git/expertcad synced 2026-01-11 18:25:40 +02:00
Code Issues Packages Projects Releases Wiki Activity
expertcad/POWERCAD30/Plugin Source/FPLAN/fplan.pas
ShevaIV 00e2ad8635 initial commit
2025-05-12 10:07:51 +03:00

21908 lines
589 KiB
ObjectPascal
Raw Blame History

unit fplan;
interface
uses DrawObjects,DrawEngine,PCTypesUtils,Windows, Messages, SysUtils, Classes,
U_Common_Classes, Graphics,Dialogs,ComCtrls, Math,PCDrawing,Powercad,menus,rrEllipses, pCDrawBox, Types;
const
// Left Right coord type
crtL1 = 1;
crtL2 = 2;
crtR1 = 3;
crtR2 = 4;
crtP1 = 5;
crtP2 = 6;
// Length Type
ltInner = 1;
ltOuter = 2;
// Cmp Intersect type
citNone = 0; // Íåòó
citSide = 1; // îäíîé ñòîðíîé
citEqual = 2; // íàêëàäûâàþòñÿ äðóã íà äðóãà
citEntry = 3; // Âõîäèò â ñåãìåíò
citAbsorb = 4; // Ïîãëàùàåò ñåãìåíò
cstWallLineWidth = 0.01;
type
TNet = class;
TNetPath = class;
TNetDoor = class;
TPosType = (ptVertical, ptHorizontal, ptAngular);
TNetSelType = (stStruct, stPath);
TWallType = (wtWall, WtOpen, wtGlass, wtHalf);
TWallStyle = (wsWall, wsLine);
TDoorType = (dtIndoor, dtOutDoor, dtMainDoor);
//Tolik 15/09/2017 --
TDoorImageType = (dtSimple, dtHalfOpened, dtFullOpened);
//
TDoorObjType = (dotNone, dotDoor, dotWindow, dotEmbrasure, dotNiche, dotArc, dotBalcony);
TDoorObjTypes = set of TDoorObjType;
// Òèï îòîáðàæåíèÿ äëèíû ñåãìåíòà - ìåæäó òî÷êàìè, âíóòðåííÿÿ, âíåøíÿÿ
TShowPathLengthType = (sltPoints, sltOuter, sltInner);
TNotifyPathEvent = procedure(Sender: TObject; SrcPath, NewPath: TNetPath) of object;
TDefineJoinedNetsEvent = function (Sender: TNet; ANetList, ACheckNetList, AResJoined: TList): Boolean of object;
TDefineMoveObjectsEvent = function(Sender: TNet; Apt: PDoublePoint; APath: TNetPath; ANetList: TList; AllowNear: Boolean=true): Boolean of object;
TDuplicateEvent = procedure(SrcObj, NewObj: TObject) of Object;
TDoorChangePathQueryEvent = procedure(Sender: TNetDoor;
APath, ANewPath: TNetPath; var CanChange: Boolean) of object;
TMergeNetPathsQueryEvent = procedure(Sender: TNet; var CanMerge: Boolean) of object;
TMergeNetsQueryEvent = procedure(ANet1, ANet2: TNet; var CanMerge: Boolean) of object;
TMergePathsQueryEvent = procedure(APath1, APath2: TNetPath; var CanMerge: Boolean) of object;
TMergePathsEvent = procedure(AMainPath, APath: TNetPath) of object;
TPathPointEvent = function(Sender: TNet; aTrgPath: TNetPath; APoint: PDoublePoint; AID: Integer): Integer of object;
TPointEvent = function(Sender: TNet; APoint: PDoublePoint; AID: Integer): Integer of object;
TGetFloatEvent = function(Sender: TObject): Double of object;
TGetHeightEvent = function(Sender: TObject): Double of object;
TGetHeightOfPtEvent = function(Sender: TObject; pt: PDoublePoint): Double of object;
TGetPathCheckOverlapMargin = procedure(Sender: TNet; Path, PathChk: TNetPath; var aMargin: Double) of object;
TGetShowPathLengthTypeEvent = function(Sender: TObject): TShowPathLengthType of object;
TPathsOverlapQuery = procedure(APath, ACheckPath: TNetPath; Apt: PDoublePoint; var ACanOverlap: Boolean) of object;
TScaleEvent = procedure(Sender: TObject; PercentX, PercentY: Double; rPoint: PDoublePoint) of object;
TSetScaleEvent = procedure(Sender: TObject; OldScale, NewScale: Double) of object;
TWallPath = class(TFigure)
Net: Tnet;
Valid: Boolean;
Refpaths: Tlist;
FStarted: Boolean;
CIndex : Integer;
Function Closed: Boolean;
Procedure SnapPoint(var x, y: Double);
constructor create(p1: TDoublepoint; xNet: Tnet);
procedure draw(DEngine: TPCDrawEngine; isGrayed: Boolean); override;
Function GetLen(p1, p2: TDoublePoint): Double; virtual;
class Function CreateShadow(x, y: Double): TFigure; override;
Function ShadowClick(ClickIndex: Integer; x, y: Double): Boolean; override;
Function ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean; override;
class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow: TFigure): TFigure; override;
Destructor Destroy; override;
function checkNoConnectedPrevPoint:Boolean;
end;
TWallRect = class(TFigure)
Net: Tnet;
Valid: Boolean;
Refpaths: Tlist;
FStarted: Boolean;
CIndex : Integer;
xLocked: Boolean;
yLocked: Boolean;
Function ShadowKeyStroke(var ClickIndex, KeyCode: Integer; Shift: TShiftState; var Fnished: Boolean): Boolean; override;
Procedure LockTrace;
Procedure UnLockTrace;
Procedure SnapPoint(var x, y: Double);
constructor create(p1: TDoublepoint; xNet: Tnet);
procedure draw(DEngine: TPCDrawEngine; isGrayed: Boolean); override;
Function GetLen(p1, p2: TDoublePoint): Double; virtual;
class Function CreateShadow(x, y: Double): TFigure; override;
Function ShadowClick(ClickIndex: Integer; x, y: Double): Boolean; override;
Function ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean; override;
class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow: TFigure): TFigure; override;
Destructor Destroy; override;
end;
TNetDoor = class(TMyObject)
a1, a2 : TDoublePoint;
b1, b2 : TDoublePoint;
ca1, ca2 : TDoublePoint;
cb1, cb2 : TDoublePoint;
p1, p2 : TDoublePoint;
ta1, ta2: TDoublePoint;
tb1, tb2: TDoublePoint;
ba1, ba2: TDoublePoint;
bb1, bb2: TDoublePoint;
Start : Double;
Width : Double;
Window: Boolean;
//Len: Double;
Height: Double;
WOffset: Double;
isDraw: Boolean;
// Tolik 21/11/2019 --
Region: HRGN;
//Region: Integer;
//
//Tolik 15/09/2017 --
DoorImageType: TDoorImageType;
Doubled: Boolean; // äâîéíûå äâåðè
Mirrored: Boolean; // â äðóãóþ ñòîðîíó (îòêð. íàðóæó)
LeftRight: Boolean; // äâîñòîðîííèå äâåðè
Opened: Boolean; // îòêðûòàÿ äâåðü (äîáàâëÿåì àðî÷íîå îòîáðàæåíèå íà 90 ãðàäóñîâ )
HalfOpened: Boolean; // ïîëóîòêðûòàÿ äâåðü (äîáàâëÿåì àðî÷íîå îòîáðàæåíèå íà 45 ãðàäóñîâ )
//
//Tolik 05/09/2018 --
WndPlacementHeight: Double;
//
DoorType: TDoorType;
DoorObjType: TDoorObjType;
DoorNbr: Integer;
Net: Tnet;
InSide: Byte;
FIndent: Integer;
ClearP1, ClearP2: TDoublePoint; //07.05.2012 - òî÷êè íèøè, ãäå óáèðàåòñÿ ëèíèÿ ñ ñåãìåíòà
FComponID: Integer;
FDeleting: Boolean;
FOnDblClick: TNotifyEvent;
FOnDoorChangePathQuery: TDoorChangePathQueryEvent;
FOnDelete: TNotifyEvent;
FOnResize: TNotifyEvent;
FOnSelect: TNotifyEvent;
FPath: TNetPath; // Preloaded Path Owner
FRotation: ShortInt; //03.05.2012 - ïåðåâîðîò îáúåêòà: 0-íå ïåðåâåðíóò, 1-180 ãðàä
FSrcDoor: TNetDoor;
FLen: Double;
procedure DefineDoorObjType;
Procedure DeleteRegion;
Procedure Draw(Dengine: TPCDrawEngine; Color: TColor);
Procedure DrawNiche(Dengine: TPCDrawEngine; Color: TColor; aStyle: Integer; pa1, pa2, pb1, pb2, cp1, cp2: PDoublePoint);
Procedure GetOutPoints(var top1, top2, bot1, bot2: TDoublePoint; PathDir: Integer);
Procedure GetInPoints(var top1, top2, bot1, bot2: TDoublePoint; PathDir: Integer);
Procedure UpdateRegion(Dengine: TPCDrawEngine);
Constructor Create(s, w, l:Double; aDoorObjType: TDoorObjType; xNet: Tnet);
Procedure CalculatePoints(xp1, xp2: TDoublePoint);
procedure SetDefParams;
Procedure WriteToStream(Stream: TStream);
Class Function CreateFromStream(Stream: Tstream; xPath: TNetPath): TNetDoor;
Destructor Destroy;override;
procedure DoClick;
procedure DoDblClick;
procedure DoDelete;
procedure DoResize;
function DoChangePathQuery(APath, ANewPath: TNetPath): Boolean;
function GetPath: TNetPath;
procedure TestSetVal(AValue: Double);
property Len: Double read FLen write TestSetVal;
end;
TPathTrace = class(TFigure)
Net: Tnet;
Clone: TNet;
FPathInClone: TNetPath; //22.04.2011
FPathInCloneInversePt: Boolean; //22.04.2011 - Íå ñîîòâåòñòâóþò ëè òî÷êè ñåãìåíòà â êëîíà èç òî÷êàìè Path
Path : TNetPath;
ShiftP: Boolean;
CtrlP: Boolean;
OPoint, p1, p2, op1, op2, xp1, xp2: TDoublePoint;
FDrawP1, FDrawP2: TDoublePoint;
NPoints1, NPoints2: TDoublePointArr;
NDrawPoints1, NDrawPoints2: TDoublePointArr;
WidthInner1, WidthInner2: Double; //15.04.2011
WidthOut1, WidthOut2: Double; //15.04.2011
SnappedNearPoint: Boolean;
SnappedGrid: Boolean;
SnappedGuide: Boolean;
Relocate: Boolean;
DeleteOld: Boolean;
Repair: Boolean;
// ArcProps //22.10.2010
IsArc: Boolean;
ArcCenter: TDoublePoint;
l1, l2, r1, r2: TDoublePoint;
Inverted: Boolean;
FMDeltaX, FMDeltaY: Double; //24.05.2011 - Move delata x y
FEDeltaX, FEDeltaY: Double; //24.05.2011 - End delata x y
FRelatedTraces: TList; //19.10.2010
FRelatedNets: TList; //21.10.2010
FIsRelated: Boolean; //19.10.2010
FRelatedOwner: TObject; //13.05.2011
Procedure Move(dx, dy: Double); override;
Procedure MoveRelated(dx, dy: Double); //19.10.2010
Procedure EndTrace;
Procedure EndTraceRelated; //19.10.2010
Constructor Create(xPath: TNetPath; xNet: TNet; Shift, ctrl: Boolean);
destructor Destroy; override; //19.10.2010
Procedure Draw(DEngine:TPCDrawEngine;isGrayed:Boolean);override;
procedure DrawArc(Dengine: TPCDrawEngine;Color:Tcolor; style:Integer);
Procedure DrawRelated(DEngine:TPCDrawEngine;isGrayed:Boolean); //19.10.2010
function IsRelatedTo(Apt1, Apt2: PDoublePoint): Boolean;
end;
TDoorTrace = class(TFigure)
Net: TNet;
Path, oPath: TNetPath;
Door: TnetDoor;
OPoint: TDoublePoint;
Start, NStart: Double;
DrawStartOffset: Double;
PathP1, PathP2: TDoublePoint; //19.04.2011
p1, p2: TDoublePoint; //11.10.2010
NLen: Double;
FIsShowLen: Boolean;
Procedure Locate(x, y: Double);
Procedure Move(dx, dy: Double);override;
Procedure EndTrace;
Constructor Create(xNet: TNet; xPath: TNetPath; xDoor: TNetDoor);
Procedure Draw(DEngine: TPCDrawEngine; isGrayed: Boolean); override;
procedure DefineActualPoints; //11.10.2010
procedure MovePoint(APoint: TDoublePoint; x, y: Double);
end;
TNetStruct = class(TMyObject)
Net: Tnet;
// Tolik 21/11/2019 --
Region: HRGN;
//Region: Integer;
//
Points: TList;
Style: Integer;
Function PathInter(p1, p2: TDoublePoint):Boolean;virtual;
Function GetDistToPoint(p:TDoublePoint):Double;virtual;
Function IsPointIn(x,y:Double):Boolean;virtual;
Procedure DrawGuides(DEngine:TPCDrawEngine);virtual;
Procedure Draw(Dengine:TPCdrawEngine;isGrayed:Boolean);virtual;
Procedure DrawTrace(Dengine:TPCDrawEngine);virtual;
Procedure Hatch(Dengine:TPCdrawEngine;isGrayed:Boolean);virtual;
Constructor Create(xNet: TNet);
Destructor Destroy; override;
Function IsKnotIn(p: PDoublePoint): Integer;
Function Duplicate: TNetStruct; virtual;
Function DuplicateNonPoints: TNetStruct; virtual;
Procedure WriteToStream(Stream: TStream); Virtual;
Class Function CreateFromStream(Stream: Tstream; xNet: Tnet): TNetStruct; virtual;
Procedure DoSolid(Faces:Tlist;topZ,botZ:Double); virtual;
Function SnapPoints(var x,y:Double;DotsPerMil:Double):Boolean;virtual;
Procedure ShowProperties;virtual;
Procedure PropUpdate(PropName, PropVal: String);virtual;
procedure GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double);virtual;
end;
TNetCol = class(TnetStruct)
p1: PDoublePoint;
Angle: Double;
w,h: Double;
Position: Byte;
Function PathInter(p1,p2:TDoublePoint):Boolean;override;
Function GetDistToPoint(p:TDoublePoint):Double;override;
Procedure IntersectPath(Path:TnetPath);
Procedure IntersectPathPipe(Path:TnetPath);
Procedure _Draw(Dengine:TPCdrawEngine;xColor:TColor;Fill:Boolean);
Procedure DrawGuides(DEngine:TPCDrawEngine);override;
Procedure Draw(Dengine:TPCdrawEngine;isGrayed:Boolean);override;
Procedure DrawTrace(Dengine:TPCDrawEngine);override;
Function GetPoints(var ap1,ap2,ap3,ap4:TDoublePoint):Boolean;
Function GetPipePoints(var ap1,ap2,ap3,ap4:TDoublePoint):Boolean;
Constructor Create(xNet:Tnet; p: PDoublePoint);
Function DuplicateNonPoints: TNetStruct;override;
Procedure SetPosition;
Procedure WriteToStream(Stream:TStream);override;
Class Function CreateFromStream(Stream:Tstream;xNet:Tnet):TNetStruct;override;
Function SnapPoints(var x,y:Double;DotsPerMil:Double):Boolean;override;
procedure GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double);override;
end;
TNetRow = class(TnetStruct)
p1,p2: PDoublePoint;
Thick: Double;
Height: Double;
a1,a2,b1,b2: TDoublePoint;
Function PathInter(p1, p2: TDoublePoint): Boolean; override;
Function GetDistToPoint(p: TDoublePoint): Double;override;
Function GetPipePoints(var aa1,aa2,bb1,bb2:TDoublePoint): Boolean;overload;
Function GetPipePoints: Boolean;overload;
Procedure DrawGuides(DEngine:TPCDrawEngine);override;
Procedure IntersectPathPipe(Path:TnetPath);
Procedure _Draw(Dengine:TPCdrawEngine;xColor:TColor);
Function GetPoints(var ap1,ap2,ap3,ap4:TDoublePoint):Boolean;
Procedure Draw(Dengine:TPCdrawEngine;isGrayed:Boolean);override;
Procedure DrawTrace(Dengine:TPCDrawEngine);override;
Constructor Create(xNet:Tnet; xp1,xp2: PDoublePoint);
Function DuplicateNonPoints: TNetStruct;override;
Function IsPointIn(x,y:Double):Boolean;override;
Procedure WriteToStream(Stream: TStream);override;
Class Function CreateFromStream(Stream: Tstream; xNet: Tnet): TNetStruct;override;
Function SnapPoints(var x,y:Double;DotsPerMil:Double):Boolean;override;
procedure GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double);override;
Procedure IntersectPath(Path:TnetPath);
end;
TInsertCol = class(TFigure)
Net: Tnet;
constructor create(p1: TDoublepoint; xNet: Tnet);
class Function CreateShadow(x, y:Double): TFigure;override;
Function ShadowClick(ClickIndex: Integer; x,y: Double): Boolean;override;
Function ShadowTrace(ClickIndex: Integer; x,y: Double): Boolean;override;
class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow:TFigure): TFigure;override;
end;
TInsertRow = class(TFigure)
Net: Tnet;
Valid: Boolean;
Procedure SnapPoint(var x,y:Double);
constructor create(p1: TDoublepoint;xNet:Tnet);
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
class Function CreateShadow(x, y:Double): TFigure;override;
Function ShadowClick(ClickIndex:Integer;x,y: Double): Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y: Double): Boolean;override;
class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow: TFigure): TFigure;override;
end;
TPathDirection = (ptL12, ptL21, ptR12, ptR21);
TnetPath = class(TMyObject)
private
procedure AfterDiv;
procedure BeforeDiv;
public
id: Integer; // Tolik 21/12/2019 --
Border: Boolean;
p1,p2: PDoublePoint;
a1,a2: TDoublePoint;
b1,b2: TdoublePoint;
l1,l2: TDoublePoint; // Temp points for offset intersections
r1,r2: TDoublePoint; // Temp points for offset intersections
Angle: Double; // Temp angle for offset intersections
Dir: Integer; // Temp drection for offset intersections
Empty1: Boolean;
Empty2: Boolean;
// Tolik 21/11/2019 --
Region: HRGN;
//Region: Integer;
//
Tag: Integer;
Net: TNet;
Deleted: Boolean;
DeadIdx: Integer;
WType: TWallType;
WStyle: TWallStyle;
Width: Double;
isArc: Boolean;
ArcAng: Double;
ArcRad: Double;
Inverted: Boolean;
ArcCenter: TDoublePoint;
ArcA1: Double;
ArcA2: Double;
ArcJoinA1: TDoublePoint;
ArcJoinA2: TDoublePoint;
ArcJoinB1: TDoublePoint;
ArcJoinB2: TDoublePoint;
ArcJoinA1L: TDoublePoint;
ArcJoinA2L: TDoublePoint;
ArcJoinB1L: TDoublePoint;
ArcJoinB2L: TDoublePoint;
Doors: TList;
DoorIndex: Integer;
Broken: Boolean;
IsoTopL1: TDoublePoint;
IsoTopL2: TDoublePoint;
IsoBotL1: TDoublePoint;
IsoBotL2: TDoublePoint;
IsoTopR1: TDoublePoint;
IsoTopR2: TDoublePoint;
IsoBotR1: TDoublePoint;
IsoBotR2: TDoublePoint;
isoP1,isoP2: TDoublePoint;
TopL1: T3dPoint;
TopL2: T3dPoint;
TopR1: T3dpoint;
TopR2: T3dPoint;
BotL1: T3dPoint;
BotL2: T3dPoint;
BotR1: T3dpoint;
BotR2: T3dPoint;
IsOut: Boolean;
HL1,HL2,HR1,HR2: TDoublePoint;
HE1,HE2: TDoublePoint;
FoundCnt: Integer;
isRow: boolean;
Info: String;
mpa,mpb: TDoublePoint;
apa,apb: TDoublePoint;
bpaA,bpbA: TDoublePoint;
bpaB,bpbB: TDoublePoint;
Style: Integer;
Opath: TNetPath; // original path of trace path
FShowLength: Boolean;
FPathStyle: TPenstyle;
FPathWidth: Integer;
//FID: Integer;
FBrushColor: Integer;
FBrushStyle: Integer;
FColor: Integer;
FComponID: Integer;
FDeleting: Boolean;
FDivedFrom: TNetPath; //14.12.2010 Îò êàêîãî ñåãìåíòà ýòîò îòäåëåí
FIsHidden: Boolean; //21.04.2011
FIsInner: Boolean; //10.12.2010 Ïðèçíàê ÷òî ñåãìåíò ìåæäó äâóìÿ êîíòóðàìè
FIsConture: Boolean; //29.05.2012 - Ó÷àñòâóåò ëè ñåãìåíò â êîíòóðå
FOnAfterDiv: TNotifyEvent; //06.10.2010
FOnBeforeDiv: TNotifyEvent; //06.10.2010
FOnDblClick: TNotifyEvent;
FOnDelete: TNotifyEvent;
FOnGetHeight: TGetHeightEvent; //12.05.2011
FOnGetHeightOfPt: TGetHeightOfPtEvent; //12.05.2011
FOnGetPathCheckOverlapMargin: TGetPathCheckOverlapMargin; //27.08.2012 - Ïîëó÷åíèå îòñòóïà äëÿ ïðîâåðêè ïååðåñå÷åíèé ñåãìåíòîâ
//FOnGetShowPathLength: TGetFloatEvent; //15.04.2011 - Òèï äëèíû äëÿ âûäåëåííîãî ñåãìåíòà
//FOnGetShowPathTraceLength: TGetFloatEvent; //15.04.2011 - Òèï äëèíû äëÿ ñåãìåíòà íà onmove
FOnGetShowPathLengthType: TGetShowPathLengthTypeEvent; //15.04.2011 - Òèï äëèíû äëÿ âûäåëåííîãî ñåãìåíòà
FOnGetShowPathTraceLengthType: TGetShowPathLengthTypeEvent; //15.04.2011 - Òèï äëèíû äëÿ ñåãìåíòà íà onmove
FOnMove: TNotifyEvent;
FOnSelect: TNotifyEvent;
FSelecting: Boolean;
FSubRegions: TList; //23.03.2013 - ïîäðåãèîíû - ó÷àñòêè ìåæäó îêíàìè/äâåðüìè/
FSrcPaths: TList;
FPointsOffset: Double;
FPerpendSide: ShortInt; // Ñ êàêîé ñòîðîíû îòîáðàæàòü, åñëè òîíüøèé ñåãìåíò: 1 - ñ äðóãîé ñòîðîíû, 2 - ïî ñðåäèíå (íà áóäóùåå)
FPerpendDX: Double;
FPerpendDY: Double;
el1,el2: TDoublePoint; // Temp points for offset intersections
er1,er2: TDoublePoint; // Temp points for offset intersections
epl1,epl2,epr1,epr2: PDoublePoint; //18.05.2012 - Ïåðïåíäèêóëÿðíûå òî÷êè - ññûëêè íà el1,el2,er1,er2 ñâÿçàííîãî ñåãìåíòà
LR1, LR2, RL1, RL2: TDoublePoint; // Òî÷êè ïîäâåäåííûå (îïóùåíû) ñ ïàðàëåëüíîé ëèíèè
op1, op2: PDoublePoint; // Âíåøíèå òî÷êè èç el èëè er
ip1, ip2: PDoublePoint; // Âíóòðåííèå òî÷êè èç el èëè er
p1H, p2H: Double; // Âûñîòû òî÷åê
Function GetPoint(PType: Integer): TDoublePoint;
Procedure SetLen(len: Double; back: Boolean);
Procedure MoveDoors(nPath: TnetPath);
Procedure Refresh;
procedure GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double);
Procedure AddCols;
Function GetLeftCorner(var wp: TDoublePoint): TDoublePoint;
Function GetRightCorner(var wp: TDoublePoint): TDoublePoint;
Function SnapToKnots(var x,y: Double; DotsPerMil: Double; SnapLine: Boolean): Boolean;
Function SnapToPipeLine(var x,y: Double; DotsPerMil: Double): Boolean;
Function SnapToCorners(var x,y: Double; DotsPerMil: Double): Boolean;
Function SnapToPipeCorners(var x,y: Double; DotsPerMil: Double): Boolean;
Function ForceSnapToPipeCorners(var x,y,dSnap: Double): Boolean;
Function ForceSnapToPipeLine(var x,y,dSnap: Double): Boolean;
Procedure IsometricDraw(Dengine: TPCDrawEngine; Color: TColor);
Procedure AddEndLine(var pArr:TDoublePointArr; Direction: TPathDirection);
Procedure AddBezierPoints(var pArr:TDoublePointArr; Direction: TPathDirection; IncFirst:Boolean);
Procedure AddWallPoints(var pArr:TDoublePointArr; Direction: TPathDirection; IncFirst:Boolean);
Procedure AddArcPoints(var pArr:TDoublePointArr; Direction: TPathDirection; IncFirst:Boolean);
Procedure AddOpenPoints(var pArr:TDoublePointArr; Direction: TPathDirection; IncFirst:Boolean);
Procedure AddHalfPoints(var pArr:TDoublePointArr; Direction: TPathDirection; IncFirst:Boolean);
Procedure AddGlassPoints(var pArr:TDoublePointArr; Direction: TPathDirection; IncFirst:Boolean);
Procedure CopyFrom(sPath: TnetPath; AWithDoors: Boolean=true);
Function Len: Double;
Function AbsLen: Double;
Function MLen: Double;
function InnerLen: Double; // Inner Len to bounds
Function ActiveDoor: TNetDoor;
Procedure CalculateDoorPoints(dp1, dp2: PDoublePoint); //22.05.2012
Procedure CalculateExternSnaps;
Procedure CalculatePoints(topZ, botZ: Double);
Function NewDoor(s, len: Double; aDoorObjType: TDoorObjType): TnetDoor;
Procedure SortDoors;
Procedure SetShape(xArc: Boolean);
Procedure SetArcAng(ang: Double);
Function IsPointIn(x,y: Double; aSelect: Boolean=true): Boolean;
Function isLineIntersect(xp1,xp2: TDoublePoint): Boolean;
Function LineIntersect(xp1,xp2: TDoublePoint; var ip: TDoublePoint): Boolean;
Function PointToWall(var p: TdoublePoint; refP: TdoublePoint): Boolean;
Function IsPointOnLine(x,y: Double): Boolean;
Function isKnotIn(p: PDoublePoint): Integer;
Function isKnotValIn(p: TDoublePoint): Integer;
Function AreYou(xp1, xp2: PDoublePoint): Boolean; overload;
Function AreYou(xp1, xp2: TDoublePoint): Boolean; overload;
Function Connected(path: TnetPath): Boolean;
Constructor Create(xp1, xp2: PDoublePoint; xBorder: Boolean; xNet: Tnet);
Procedure Initialize; // Tolik 21/12/2019 --
Procedure WriteToStream(Stream: TStream);
Class Function CreateFromStream(Stream: TStream; xNet: Tnet; aOldPlan: Boolean): TnetPath;
Procedure Hatch(DEngine: TPCDrawEngine; isGrayed: Boolean);
Function CreateInRgn(DEngine:TPCDrawEngine): HRGN;
Function CreateLinearRgn(DEngine:TPCDrawEngine): HRGN;
procedure CreateLinearSubRgns(DEngine:TPCDrawEngine);
Function CreateArcRgn(DEngine:TPCDrawEngine): HRGN;
Procedure Move(dx, dy: Double);
Procedure MoveDoor(delta: Double);
Procedure DeleteDoor;
Procedure DeleteDoors;
Function PosType: TPosType;
Function ISClosed: Boolean;
Procedure Draw(Dengine:TPCDrawEngine;Color:TColor);
Procedure DrawOpen(Dengine:TPCDrawEngine;Color:TColor);
Procedure DrawGlass(Dengine:TPCDrawEngine;Color:TColor);
Procedure DrawHalf(Dengine:TPCDrawEngine;Color:TColor);
Procedure DrawWall(Dengine:TPCDrawEngine;Color:TColor);
Procedure DrawGuides(DEngine:TPCDrawEngine);
Procedure DrawArc(Dengine:TPCDrawEngine;Color:Tcolor; style:Integer);
Procedure DrawTrace(Dengine:TPCDrawEngine);
Procedure UpdateRegion(Dengine:TPCDrawEngine);
Procedure DeleteRegions;
Procedure DrawDoors(Dengine:TPCDrawEngine;Color:TColor);
Function HasDoor: Boolean;
Destructor Destroy;override;
Procedure ClearDoors;
Function OtherPoint(p:PDoublePoint):PDoublePoint;
Procedure SetType(xType:TWallType);
Function Overlaps(path: TnetPath): Boolean;
Procedure DrawOuterCorners(DEngine:TPCDrawEngine;Color,Width,Style:Integer);
Procedure DrawInnerCorners(DEngine:TPCDrawEngine;Color,Width,Style:Integer);
// Ïðèáàâëÿåò äëèíó, çíà÷åíèå ALen ì.á. îòðèöàòåëüíûì
function AddDoorAtPt(pt: TDoublePoint; len: Double; aDoorObjType: TDoorObjType): TnetDoor;
procedure AddLen(ALen: Double); //15.10.2010
procedure AfterLoadProps;
procedure ApplyStyle(Dengine:TPCDrawEngine; Color:TColor); //17.03.2013
procedure Assign(ASource: TNetPath);
procedure AssignProps(APath: TNetPath);
function CmpIntersectPath(APath: TNetPath; MarginDelta:Double = 2; AEqualRotate: Pointer=nil): Integer;
procedure DefineDoorsOwner;
procedure DefineInOutPoints; //10.12.2010 Îïðåäåëÿåò âíóòðåííèå/âíåøíèå òî÷êè ñåãìåíòà
Procedure DeleteDoorObj(ADoor: TNetDoor);
procedure DoDelete;
Procedure DoClick(X, Y: Double);
Procedure DoDblClick;
Procedure DrawArcCenter(Dengine:TPCDrawEngine; Color:Tcolor; Style:Integer);
function ExistsPerpendPt: Boolean;
procedure FillArcJoinPoints(aPoints, aLPoints: TList);
procedure FillArcPointsByEndPoints(var aPoints: TDoublePointArr; ap1, ap2: PDoublePoint; aDxfMode: Boolean=false);
procedure FillRegions(Dengine: TPCDrawEngine; aBrushColor: TColor; aBrushStyle: Integer);
function GetArcLPointByPt(apt: PDoublePoint): PDoublePoint;
function GetConnected(APt: PDoublePoint): TNetPath; // Âåðíåò ïåðâûé ïîäêëþ÷åííûé ñåãìåíò ïî òî÷êå
function GetConnectedPoint(APath: TNetPath): PDoublePoint; // Âåðíåò òî÷êó ê êîòîðîé ïîäêëþ÷åí ñåãìåíò
//28.05.2012 - Êàêîé ñòîðîíîé ïîäêëþ÷åíû ê ñåãìåíòó
function GetConnectedSide(APath: TNetPath): Integer;
function GetConturePolygon: TDoublePointArr;
function GetConturePoints(aAllowEPoints: Boolean; aPointSide: Integer=0; aPathSide: Char=#0): TList;
function GetDoorByComponID(AComponID: Integer): TNetDoor;
//11.04.2012 - âåðíåò ïîëí³é êîíòóð ñåãìåíòà - ìåíüøàÿ ñòîðîíà ïîäòÿãèâàåòñÿ ïîä áîëüøóþ
function GetFullConture: TDoublePointArr;
function GetHeight: Double;
function GetHeightOfPt(pt: PDoublePoint): Double;
// Âåðíåò äëèíó ìóæäó òî÷êàìè, ó÷èòûâàåò åñëè äóãà
function GetLenByPoints(p1, p2: TDoublePoint): Double; //28.10.2010
// Âåðíåò äëèíó äëÿ ïîêàçà
function GetLenForShow(AShowPathLengthType: TShowPathLengthType): Double;
function GetObjInPoint(x, y: Double): TObject; //17.01.2011
function GetPointByLenghType(ASideNum: Integer; aLengthType: TShowPathLengthType): PDoublePoint; //28.04.2012
//24.05.2012 - Âåðíåò òî÷êó, êîòîðàÿ ñîåäèíÿåòñÿ ñ ïåðïåíäèêóëÿðíîé
function GetPointByPerpend(aPerpendPt: PDoublePoint): PDoublePoint;
// Âåðíåò òî÷êè ïî íîìåðó ñòîðîíû
function GetPointsBySide(ASideNum: Integer; var L, R, LR, RL: TDoublePoint): Boolean;
function GetPointBySide(ASideNum: Integer): PDoublePoint;
function GetPointSide(aPoint: PDoublePoint): Integer;
// Âåðíåò òî÷êè ñòîðîíû, êîòîðûå îïèñûâàþò òðåóãîëüíèê L, R, (LR || RL)
function GetTrianglePointsBySide(ASideNum: Integer; var L, R, T: TDoublePoint): Boolean;
procedure InvertPerpendSide(aUpdateRegion: Boolean=true);
function IsInnerNiche(aNiche: TNetDoor; aRefreshPathPoints: Boolean=false): Boolean;
// ïîëó÷èòü äëèíó âíóòðåííåé/âíåøíåé ÷àñòè
function LenByType(AType: Integer): Double; //15.10.2010
function OutLen: Double;
// Äëèíà ÷àñòè ñåãìåíòà çà èñêëþ÷åíèåì óãëîâ
function ProperLen: Double;
// Îïðåäåëÿåò òî÷êè, ïðîâåäåííûå ñ ïàðàëåëüíûõ ëèíèé
procedure PointToParralelLine;
function SecondPoint(p: PDoublePoint): PDoublePoint;
procedure SetEPoints;
// Óñòàíîâèòü äëèíó ñåãìåíòà ïî âíóòðåííåé ÷àñòè
procedure SetInnerLen(ALen: Double); //15.10.2010
// // Óñòàíîâèòü äëèíó ñåãìåíòà ïî âíóòðåííåé/âíåøíåé ÷àñòè
procedure SetLenByType(ALen: Double; AType: Integer);
// Óñòàíîâèòü äëèíó ñåãìåíòà ïî âíåøíåé ÷àñòè
procedure SetOutLen(ALen: Double); //15.10.2010
procedure Select;
procedure SelectDoor(ADoor: TNetDoor);
procedure TestShowPointsInfo;
Function GetRelatedPaths: TList;
End;
TNet = class(TFigure)
Points: TList;
Paths: TList;
Structs: TList;
SelType: TNetSelType;
SelIndex: Integer;
PathRgn: HRGN;
XDrawEngine: TPCDrawEngine;
MapScale: Double;
FillWalls: Boolean;
WallThick: Double;
WorkHeight: Double;
WorkWidth: Double;
IsometricUpdate: Boolean;
TopZ: Double;
BotZ: Double;
EndDraw: Boolean;
ContextMenu: Boolean;
DrawGuides: Boolean;
EditMode: Boolean;
DrawAsTrace: Boolean;
DetDraw: Boolean;
ShowPathCenters: Boolean;
ShowDims: Boolean;
WorldDim: Boolean;
//FID: Integer;
FAllowDelPathOnMake: Boolean;
//FAllowCleanSamePointsInGrpPointArray: Boolean; //21.06.2012 - ïîçâîëÿòü ÷èñòèòü ìàññèâ òî÷åê äëÿ ñîçäàíèÿ ñåãìåíòà
FAllowAddPathWithSamePoints: Boolean; //21.06.2012 - ïîçâîëÿòü äîáàâëÿòü ñåãìåíòû ñ òî÷êàìè íà äèíàêîâûå êîîðäèíàòû
FCmpPointPrecision: Double; // òî÷íîñòü äëÿ ñðàâíåíèÿ òî÷åê
FComponID: Integer;
FDeleting: Boolean;
FDisableMergePaths: Boolean;
FDrawedPt1: TList; //13.05.2011 - îòðèñîâàííûå òî÷êè ñ îäíèõ ñòîðîí
FDrawedPt2: TList; //13.05.2011 - îòðèñîâàííûå òî÷êè ñ îäíèõ ñòîðîí
FFigureModification: Boolean;
// Tolik 28/08/2019 --
//FLastTickTraceRefresh: Cardinal;
FLastTickTraceRefresh: DWord;
//
FMoveAllPoints: Boolean;
FOnAddPoint: TPathPointEvent; //04.10.2010
FOnAutoAddPath: TNotifyPathEvent;
FOnDefineJoinedNets: TDefineJoinedNetsEvent; //26.05.2011
FOnDefineMoveObjects: TDefineMoveObjectsEvent; //23.05.2011
FOnDelete: TNotifyEvent;
FOnDeletePoint: TPointEvent; //04.10.2010
FOnDuplicate: TDuplicateEvent; //16.05.2011
FOnMergePaths: TMergePathsEvent; //13.01.2011
FOnMergePathsQuery: TMergePathsQueryEvent; //21.10.2010
FOnMergeNetPathsQuery: TMergeNetPathsQueryEvent;
FOnMergeNetsQuery: TMergeNetsQueryEvent; //21.10.2010
FOnMove: TNotifyEvent; //09.06.2011
FOnMoveJoinedPoints: TNotifyEvent; //09.06.2011
FOnMovePoint: TPointEvent;
FOnPathsOverlapQuery: TPathsOverlapQuery; //10.05.2011
FOnResize: TNotifyEvent;
FOnScale: TScaleEvent;
FOnScaleAfter: TNotifyEvent;
FOnScaleBefore: TNotifyEvent;
FOnSetScale: TSetScaleEvent;
FOnSelectPoint: TPointEvent; //05.10.2010
FPathDivision: TNetPath; //26.03.2013
FPointIDs: TList;
FSelectingPt: Boolean;
FSelection: TList;
FSelPtIdx: Integer;
FPathTracePoint: PDoublePoint; //21.10.2010 òî÷êà èç PathTrace âëàäåëüöà
FRelatedOwner: TObject; //21.10.2010
FRelatedPoints: TList;
FRelatedMPoint: PDoublePoint; //19.10.2010 - Move-point ïî êîòîðîì äàííûé Net
// (íàõîäÿùèéñÿ â ñïèñêå FRelatedNets äðóãîãî) ñâÿçàí ïî êîîðäèíàòàì ñî ñâîèì âëàäåëüöåì
FRelatedMPath: TNetPath; //24.05.2011 - move trace path ïî êîòîðîìó äàííûé Net
// (íàõîäÿùèéñÿ â ñïèñêå FRelatedNets äðóãîãî) ñâÿçàí ïî êîîðäèíàòàì ñî ñâîèì âëàäåëüöåì
FRelatedObject: TObject;
FRelatedNets: TList; //19.10.2010
FJoinedMovePoints: TList; //23.05.2011 - Äîï. òî÷êè, êîòîðûå ïåðåìåùàþòñÿ çà modpoint
FJoinedMovePointsDirections: TList; //23.05.2011 - íàïðàâëåíèÿ ïåðåìåùåíèÿ äîï. òî÷åê
FJoinedMovePointsFixedState: TList; //27.05.2011 - Çàôèêñèðîâàííàÿ ïîçèöèÿ òî÷êè ê ïîäêëþ÷åííîìó ñåãìåíòó
FJoinedMovePaths: TList; //23.05.2011 - Äîï. ñåãìåíòû, êîòîðûå ïåðåìåùàþòñÿ çà pathtrace
FJoinedMovePathsDirections: TList; //23.05.2011 - íàïðàâëåíèÿ ïåðåìåùåíèÿ äîï. ñåãìåíòîâ
FSavedPoints: TList; //24.05.2011 - Ñïèñîê çàïîìíåíûõ òî÷åê
FSavedScaledPoints: TList; //23.09.2011 - Ñïèñîê çàïîìíåíûõ ïîñëå scale
FSrcNet: TNet; //21.10.2010 Îáúåêò èç êîòîðîãî ñêîïèðîâàí ýòîò
FIsGroup: Boolean;
protected
FPerpendPoints: TList;
function GetAp1: TDoublePoint;override;
public
Function SelPath: TnetPath;
function SelPt: PDoublePoint;
Function SelDoor: TnetDoor;
Function SelWindow: TnetDoor;
Function SelCol: TnetCol;
Function SelRow: TnetRow;
Function SelCenter: TDoublePoint;
Procedure RefreshColPositions;
Function AddPoint(p: TDoublePoint; aTrgPath: TNetPath=nil): PDoublePOint;
Function AddPath(p1, p2: PDoublePoint; Border: Boolean): TNetPath;
Function GetNetPath(p1,p2: PDoublePoint): TnetPath;
Function MakePathArc(pArr: TDoublePointArr; dontRefresh: Boolean = False): TNetPath; //22.10.2010
Function MakePath(pArr: TDoublePointArr; dontRefresh: Boolean = False): TnetPath;
Function MakePathOnShadow(pArr: TDoublePointArr; dontRefresh: Boolean = False): TnetPath;
Function CreatePaths(pArr: TDoublePointArr; dontRefresh: Boolean = False): TNetPath;
Procedure RefreshRegions(DEngine: TPCDrawEngine);
Procedure DeleteRegions;
Procedure DeleteNonePaths;
Procedure MarkBrokenPaths;
Function FindBrokenPath(xPaths: TList): TnetPath;
Function FindStartPoint(xPaths: TList): PDoublePoint;
Function FindStartPath(cPaths: TList; p: PDoublePoint): TnetPath;
Function FindClockPath(cPaths: TList; p: PDoublePoint; oPath: TnetPath): TnetPath;
Function FindClockWPath(cPaths: TList; p: PDoublePoint; oPath: TnetPath): TnetPath;
Function FindCloserPath(p: TDoublePoint): TNetPath;
Function FindLenToCloserStruct(p: TDoublePoint): Double;
Procedure GetPathsOfKnot(p: PDoublePoint; var xPaths: TList); overload;
Procedure GetStructsOfKnot(p: PDoublePoint; var xStructs: TList);
Procedure GetPathsOfKnot(p: PDoublePoint; lPaths: Tlist; var xPaths: TList);overload;
Function CountPathsOfKnot(p:PDoublePoint;lPaths:Tlist): Integer;
Function CountIntersectingPathsOfKnot(p:PDoublePoint;lPaths:Tlist): Integer;
Function GroupPathPointsByIntersection(pArr:TDoublePointArr;var pGrp:TDoublePointGroup): Boolean;
Function FindIntersections(p1,p2:TDoublePoint; var pArr:TDoublePointArr):Boolean;
//Tolik --17/10/2016--
//Function InsertKnot(p:TDoublePoint;force:Boolean=false; aPathOnKnot: Pointer=nil):PDoublePoint;
Function InsertKnot(p:TDoublePoint;force:Boolean=false; aPathOnKnot: Pointer=nil; aPrevPoint: pDoublePoint = nil):PDoublePoint;
// Tolik --19/10/2016--
Procedure CorrectNetPathPosbyRelatedPath(aPath: TNetPath; dx,dy: double);// ïîïðàâèòü ïîëîæåíèå îáúåêòà ïîñëå ñäâèãà
Function GetSCSRoomConture(aNet: TNet): TDoublePointArr; // Tolik 22/06/2018 --
//
Function IsPOintOnWall(p: TDoublePoint): Boolean;
Function PointOnPath(p:TDoublePoint): TNetPath;
Function GetPathOfPoint(x,y:Double): TnetPath;
Procedure FindLeftPaths(pathList:TList; ReList:TList);
Procedure FindRightPaths(pathList:TList; ReList:TList);
Procedure FindTopPaths(pathList:TList; ReList:TList);
Procedure FindBottomPaths(pathList:TList; ReList:TList);
function FindClosedRegions(pathList:TList): TList;
Function GetCenterOfPaths(Paths: TList): TDoublePoint;
Function FindMostSWPath(pathList: TList): TNetPath;
Function FindMostSEPath(pathList: TList): TNetPath;
Function FindMostEPath(pathList: TList): TNetPath;
//constructor create(LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent); //04.06.2010
constructor create(LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent);
Destructor Destroy;override;
Procedure ClearPaths;
Procedure ClearNetPoints;
Procedure ClearStructs;
procedure draw(DEngine: TPCDrawEngine; isGrayed: Boolean);override;
Procedure DrawFigureGuides(DEngine: TPCDrawEngine);override;
procedure drawline(DEngine:TPCDrawEngine;p1,p2:TDoublePoint;Color,Width:Integer;Style:TPenStyle);
Procedure RefreshPaths(aUpdateRegion: Boolean=true);
Procedure CalculatePathPoints;
Function SnapPoints(var x,y: Double; DotsPerMil: Double): Boolean;override;
Function SnapToKnots(var x,y: Double; DotsPerMil: Double; SnapLine: Boolean): Boolean;
Procedure FindClosestSnap(var x,y:Double);
Procedure GetModPoints(ModList: TMyList);override;
class function CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure;override;
Procedure Initialize;override;
Function Edit: Boolean;Override;
Procedure Move(deltax, deltay: Double);override;
Procedure Rotate(aAngle: Double; cPoint: TDoublePoint);override;
Procedure Mirror(Point1,Point2: TDoublePoint);override;
Function FindPathOfPoints(p1,p2:TDoublePOint): TNetPath;
procedure BeforeAllScale(Sender: TObject);
procedure ScaleAllEvent(Sender: TObject);
procedure AfterAllScale(Sender: TObject);
Procedure Scale(px,py: Double; rPoint: TDoublepoint);override;
Procedure Clear;
function IsPointIn(x,y: Double): boolean;override;
Function duplicate: TFigure; override;
Procedure Drawselectionpoints(DEngine: TPCDrawEngine;isGrayed:Boolean);override;
Procedure SnapModPoint(var x,y:Double; mp:TModPoint; traceNet:TNet);
Procedure NormalizeKnot(p: PDoublePoint; Net: Tnet);
function LocatePoint(p: PDoublePoint; x, y: Double; allowCheckValid: Boolean=true): Boolean;
Procedure LocatePathPoint(p: PDoublePoint; x,y: Double);
Procedure MovePath(path:TNetPath;dx,dy:Double);
Procedure DoublePath(path: TNetPath; delta: Double);
Procedure LocatePath(path: TNetPath; delta: Double; delOld, repair: Boolean);
Procedure MovePathDoor(path: TNetPath; delta: Double);
Function PathsValid(p: PDoublePOint): Boolean;
Function DuplicateByBorder: TNet;
Function DuplicateByKnot(p:PDoublePoint; AAllPaths: Boolean=false): Tnet;
Function DuplicateByPath(p:TNetPath;Group:Boolean=False; AAllPaths: Boolean=false): Tnet;
Procedure CollectBoundPoints(p:TNetPath; var BPoints1,BPoints2: TDoublePointArr; APathTrace: TPathTrace=nil);
Procedure EqualTracePaths;
Procedure MoveSatih(rpath: TNetPath; dx,dy: Double; Control: Boolean);
Procedure GetBounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
Procedure GetSelBounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
Procedure GetPathBounds(xPaths:Tlist;var figMaxX,figMaxY,figMinX,figMinY: Double; aLengthType: TShowPathLengthType=sltPoints);
procedure GetSize(aLengthType: TShowPathLengthType; var figHeight, figWidth: Double); //28.04.2012 - ðàçìåðû îáúåêòà
Function PointIndex(p: TDoublePoint): Integer;
Function PathIndex(p1,p2: TDoublePoint): Integer;
Procedure IntersectPaths(UseCols: Boolean = True);
Procedure IntersectCorner(pIndex: Integer);
Procedure FillColSpaces;
Procedure IntersectColCorner(pIndex: Integer);
Procedure IntersectColPipeCorner(pIndex: Integer);
Procedure IntersectPipeCorner(pIndex: Integer);
Procedure GetCornerPatch(pIndex: Integer; var pArr:TdoublePointArr);
Function GetKnotCol(p:PdoublePoint):TnetCol;
Procedure DeleteSelected;
Procedure OpenSelPath;
Procedure SetWallType(wt: TWallType);
Procedure SetWallKris(val: Boolean);
Procedure DoorLen(ww:Double);
Procedure ArcSelPath;
Procedure SetArcPath(a:Boolean);
Procedure InvertSelPath;
Procedure InvertSelPathValue(val: Boolean);
Procedure EditArcAng;
Procedure SetArcAng(val:Double);
Procedure ColPosition(pos:Integer);
Procedure ColAngle(ang:double);
Procedure ColWidth(cw:double);
Procedure ColHeight(ch:double);
Procedure RowThick(th:double);
Procedure DivSelPath;overload;
Procedure DivSelPath(mp: TDoublePOint);overload;
Procedure LocateSelPath(Delta:Double;delOld,repair:Boolean);
Procedure DoubleSelPath(Delta:Double);
function AddDoor(aDoorObjType: TDoorObjType=dotDoor; aLen: Double=-1): TNetDoor;
function AddWindow(aLen: Double=-1): TNetDoor;
Procedure AddNetCol; overload;
Procedure AddCol;
Function AddNetCol(p: TdoublePoint): TnetCol; overload;
Function AddNetRow(xp1, xp2: TdoublePoint): TNetRow;
// Tolik
Function CheckDeleteInnerWalls(aCanDeleteWalls: Boolean = False): Boolean;
//
Function DeletePath(Path:TnetPath):Boolean;
Function DeletePathSilent(Path:TnetPath):Boolean;
Procedure DeleteStruct(Struct:TNetStruct);
Procedure UpdateMenu(var PopMenu: TPopUpMenu;var sIndex:integer);override;
Procedure MenuClicked(CommandId:integer);override;
Procedure UpdatePathRegion(Dengine: TPCDrawEngine);
Class Function InsideSelection: Boolean; override;
procedure ResetRegion;override;
procedure UpdateAllRegions(Dengine:TPCDrawEngine);
Procedure AddCols;
Procedure RefreshPoints;
Procedure CombinePathsOfKnot(p: PDoublePoint);
Procedure OpenAllWindows;
Procedure WriteToStream(Stream: TStream);override;
Procedure SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); override;
Procedure UpdateWallThick(Value: Double);
Function CreateMoveTrace: TFigure;
Function CreateModification: TFigure; override;
Function TraceModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure;
x, y: double; Shift: TShiftState): boolean; override;
Function EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure;
x, y: double; Shift: TShiftState): boolean; override;
procedure SetModified; //03.02.2012
procedure AfterUndo(Sender: TObject);
function CanMoveJoined: Boolean;
Function CheckForPoints(pp: TDoublePoint; aPrevPoint: PDoublePoint = nil): PDoublePoint;
function CheckIntersect(ANet: TNet): Boolean;
function CheckLocatePoint(p: PDoublePoint; x, y: Double): Boolean;
function CheckOtherNetModification: Boolean;
function CheckPtInJoinedMove(Apt: PDoublePoint): Boolean;
procedure ClearRels; //21.10.2010
procedure ClearSavedScaledPoints;
procedure ClearSavedPoints;
procedure ClearPointsList(AList: TList);
function CmpIntersectPaths(p1,p2, ap1, ap2: PDoublePoint; MarginDelta:Double = 2; AEqualRotate: Pointer=nil): Integer;
function CmpDP(p1,p2: PDoublePoint): Boolean; //18.02.2011 - ñðàâíèâàåò òî÷êè ñ ó÷åòåîì òî÷íîñòè
function CreateDuplicate: TNet;
procedure BeforeDelFromParent(Sender: TObject);
procedure DefineInOutPoints;
procedure DeleteNet;
procedure DeletePoint(APoint: PDoublePoint); //#From Oleg# //04.10.2010
procedure DeSelect; override;
function DivPath(APath: TNetPath; APoint: TDoublePoint): PDoublePoint;
procedure DrawRelated(DEngine: TPCDrawEngine; isGrayed: Boolean); //19.10.2010
procedure DoClick(X, Y: Double);
procedure DoClickPoint(APoint: PDoublePoint);
procedure DoDelete;
procedure DoResize;
//08.05.2012 - Åñòü ëè ñåãìåíò, ëåæàùèé íà òðàåêòîðèè ïåðåìåùåíèÿ äðóãîãî ñåãìåíòà
function ExistsPathOnPathTrajectory(aPath: TNetPath; beginP1, beginP2: PDoublePoint): Boolean;
function FindPathInRelatedNearPoints(Ap1, Ap2: PDoublePoint): TNetPath; //19.10.2010
function GetContureByPt: TDoublePointArr;
function GetLengthForShow(ALength: Double): Double;
function GetMainTraceNet: TNet;
function GetObjInPoint(x, y: Double): TObject;
function GetPathByMainPoint(APoint: TDoublePoint): TNetPath;
function GetPathByNearPoints(APoint1, APoint2: PDoublePoint; delta: Double=1): TNetPath; //19.10.2010
function GetPathByPointsIn(p1, p2: TDoublePoint): TNetPath;
function GetPathCountByPoint(aPt: PDoublePoint): Integer;
// Âåðíåò âñå ñåãìåíòû êîòîðûå ñõîäÿòñÿ â òî÷êå
function GetPathListByPoint(APoint: PDoublePoint): TList; //05.10.2010
function GetPathListByPointID(APointID: Integer): TList; //05.10.2010
function GetPoint(x,y: Double; AOtherNearPoints: TList=nil): PDoublePoint;
function GetPointByNear(ANearPoint: TDoublePoint; ASkipList: TList=nil): PDoublePoint;
function GetPointsByNear(ANearPoint: TDoublePoint; ASkipList: TList=nil): TList;
function GetPointByID(APointID: Integer): PDoublePoint; //05.10.2010
function GetPointFromList(AList: TList; ANetPt: PDoublePoint): PDoublePoint;
function GetPointID(APoint: PDoublePoint): Integer; //07.10.2010
function GetPointPath(APoint: PDoublePoint): TNetPath; //21.10.2010 Âåðíåò Path êîòîðîìó ïðåíàäëåæèò Point
function GetSavedScaledPtByPoint(pt: PDoublePoint): PDoublePoint;
function GetSavedPtByPoint(pt: PDoublePoint): PDoublePoint;
function GetSelectedObject: TObject;
function IsPathDrawed(ap1, ap2: PDoublePoint): Boolean;
function IsPointInArc(p: PDoublePoint): Boolean;
function IsRectangle: Boolean;
Procedure ModifySelection(mm: TModifyMode; value: Integer);override; //16.03.2013
function MoveJoinedPoints(ADeltaX, ADeltaY: Double; AFromSaved: Boolean): Boolean;
procedure RotateAllNiche;
//procedure RestorePointsFromSaved;
procedure SaveScaledPoints;
procedure SavePoints;
procedure SavePointsToList(AList: TList);
procedure SelectAllPaths;
function SelectNextPathByPt(x,y: Double): Boolean;
function SelectNextPointByPt(x,y: Double): Boolean;
procedure SelectPt(APt: PDoublEPoint);
procedure SelectPath(AIndex: Integer; AllowMultisel: Boolean=false);
procedure SetMapScale(AMapScale: Double);
procedure SetPathsHidden(AHidden: Boolean);
procedure SetPointID(APoint: PDoublePoint; AID: Integer);
// IGOR
// ïîëó÷èòü êîíòóð êîìíàòû
function GetRoomConture(aPaths: TList=nil): TDoublePointArr;
function GetRoomSCSConture(aPaths: TList=nil): TDoublePointArr; // Tolik 27/06/2018 --
// ïîëó÷èòü âíóòðåííèé êîíòóð êîìíàòû
function GetRoomInnerConture: TDoublePointArr;
// ïîëó÷èòü âíåøíèé êîíòóð êîìíàòû
function GetRoomOuterConture: TDoublePointArr;
// ïîëó÷èòü êîíòóð ïîëà
function GetFloorConture: TDoublePointArr;
// ïîëó÷èòü êîíòóð ïîòîëêà
function GetCeilingConture: TDoublePointArr;
// ïîëó÷èòü ñëåä. ñòåíó ïî ìîä ïîèíòó
function GetNetPathByP1P2(aCurNetPath: TNetPath; p: TDoublePoint): TNetPath;
function GetNextNetPathByP1P2(aPaths: TList; aCurNetPath: TNetPath; p: PDoublePoint; aSide: Pointer = nil): TNetPath; //24.05.2012
// 2011-05-10
function GetNetPathByR1R2(aCurNetPath: TNetPath; p: TDoublePoint): TNetPath;
// íàéòè ñòàðòîâóþ òî÷êó äëÿ íàõîæäåíèÿ íåçàìêíóòîãî êîíòóðà
function FindStartConturePPoint(aPointPath: Pointer = nil; aSide: Pointer = nil): TDoublePoint;
function FindStartConturePoint(aPaths: TList; aPointPath: Pointer = nil; aSide: Pointer = nil): PDoublePoint;//24.05.2012
// 2011-05-10
function FindStartContureRPoint: TDoublePoint;
//10.05.2012 - Âåðíåò âñå ñâÿçàííûå TNet
function GetRelatedNets(AllowPathCmpType: Integer=citNone; ASubRelNets: Boolean=false): TList;
// Âåðíåò ñâÿçàííûå TNet îáúåêòû ïî òî÷êå
function GetRelatedNetsByPoints(APoint1, APoint2: PDoublePoint; AllowPathCmpType: Integer=citNone; ASubRelNets: Boolean=false): TList;
function GetRelatedPaths(APath: TNetPath; ACmpRes: TList=nil; AllowBySide: Boolean=false): TList;
function GetRelatedPoints(APoint: PDoublePoint; AOutPoints: TList=nil; APointNets: TList=nil): TList; // Âåðíåò ñïèñîê ID òî÷åê ïî êîîðäèíàòàì
// Âåðíåò âûäåëåííóþ äâåðü/îêíî
function GetSelPathChild: TNetDoor;
function PointToOrthogonal(APoint: PDoublePoint; x, y: Double; ANet: TNet; APointMoved: Pointer=nil): TDoublePoint;
procedure SrvDropFComponID;
end;
function IfFiguraIsRoof(AFigure: TObject): boolean;
function CheckContrureEntry(AOuterConture, AInnerConture: PDoublePointArr;
ACheckNoInBorder: Boolean=false; ACheckNoAdjacent: Boolean=false; IsRoof: boolean=false): Boolean;
function CheckConturesEqual(AConture1, AConture2: PDoublePointArr): Boolean;
// Ïðîâåðÿåò ïîïàäàåò ëè ëþáàÿ òî÷êà èç ìàññèâà âî âíóòðåííèé êîíòóð îáúåêòà TNet; APoints is link to TDoublePointArr
function CheckPtInNetConture(APoints: Pointer; ANet: TNet; AAnyPoint: Boolean): Boolean;
procedure CleanSamePointsArr(var Arr: TDoublePointArr);
procedure ClearJoinedParamsInNets(ANetList: TList);
function CreatePolygonRgnByPoints(DEngine: TPCDrawEngine; p1,p2,p3,p4: PDoublePoint): HRGN;
function GetAllNets(aPCad: TPowerCad): TList;
function GetCoordTypeByPt(aPt: PDoublePoint; aPath: TNetPath): Integer;
//07.05.2012 - Âåðíåò ñïèñîê èç TNet îáúåêòîâ, ñåãìåíòû êîòîðûõ ñîäàðæàò òî÷êè p1, p2
function GetNetsByPoints(aPCad: TPowerCad; p1, p2: PDoublePoint; aNetsPath: TList=nil): TList;
function GetOtherSide(aSide: Integer): Integer;
procedure GetPathsConturePoints(ANetPaths: TList; AResultOuter, AResultInner{, AOuterHeights, AInnerHeights}: Pointer; AWithHeights: Boolean;
AOutPaths, AInnPaths: TList; AOutPointIDs, AInnPointIDs: TList);
function GetRelCoordType(ACoordType: Integer): Integer;
function GetRelCoordTypeAtSide(ACoordType: Integer): Integer;
function IsPtInArray(APt: TDoublePoint; APointArray: PDoublePointArr): Boolean;
//function IsPtIn
function IsPtInPolygon(APt: TDoublePoint; APollygonPaths: TDoublePointArr; APointsAsLines:Boolean=true; AllowCommonPoint: Boolean=false; AMul: Integer=0): Boolean;
function GetNetObjInPoint(PCAD: TPCDrawing; LayerNbr:Integer; x,y: Double; OnlyNet: Boolean=false): TObject;
Function PointNear(p1,p2: TDoublePoint; delta: Double=1):Boolean;
// Óâåëè÷èâàåò/óìåíüøàåò êîíòóð ñ ïîìîùþ TNet îáúåêòà
function ScaleConturePoints(var APoints: TDoublePointArr; ASize: Double): Boolean;
//Ïîèñê êîîðäèíàòû Z
Function GetZPoint(aNet: TNet;Point: PDoublepoint): double;
type
TUndoProc = Procedure;
var
UndoProc: TUndoProc = nil;
Var
ActiveNet: Tnet;
//FFigureModification: Boolean = false;
GDefWallType: TWallType = wtWall;
implementation
// 2011-05-10
uses U_Common, U_Cad, U_Constants, U_BaseCommon, U_ArchCommon, U_SCSComponent, {U_Arch3D}U_Arch3DNew, U_Main;
{ TNet }
Function GetZPointByID(aNet: TNet;ID: Integer): double;
var
ArchObj: TSCSComponent;
Node: TTreeNode;
HeightWall1,HeightWall2: Double;
WallSCSCompon: TSCSComponent;
begin
result := 0;
ArchObj := nil;
ArchObj := GetArchObjByCADObj(aNet);
if Assigned(ArchObj) then
begin
//Óçíàåì íîóä
Node := TF_Main(ArchObj.ActiveForm).FindComponOrDirInTree(ID, true);
if Node <> nil then
begin
//óçíàåì ÑÊÑ êîìïîíåíò
WallSCSCompon := TF_Main(ArchObj.ActiveForm).GetComponentFromNode(Node);
if WallSCSCompon <> nil then
Result := WallSCSCompon.GetPropertyValueAsFloat(pnHeight) * (1000/ TPowerCad(aNet.Owner).MapScale);
end;
end;
end;
Function GetZPoint(aNet: TNet;Point: PDoublepoint): double;
var
ID: Integer;
ArchObj: TSCSComponent;
Node: TTreeNode;
HeightWall1,HeightWall2: Double;
WallSCSCompon: TSCSComponent;
begin
result := 0;
ArchObj := nil;
ArchObj := GetArchObjByCADObj(aNet);
if Assigned(ArchObj) then
begin
ID := aNet.GetPointID(Point);
//Óçíàåì íîóä
Node := TF_Main(ArchObj.ActiveForm).FindComponOrDirInTree(ID, true);
if Node <> nil then
begin
//óçíàåì ÑÊÑ êîìïîíåíò
WallSCSCompon := TF_Main(ArchObj.ActiveForm).GetComponentFromNode(Node);
if WallSCSCompon <> nil then
Result := WallSCSCompon.GetPropertyValueAsFloat(pnHeight) * (1000/ TPowerCad(aNet.Owner).MapScale);
end;
end;
end;
Function fToStr(Value:Double): String;
begin
result := '';
Value := Trunc(Value*10000);
Value := Value/10000;
result := floattostrf(Value,ffGeneral,8,2);
end;
procedure SortPathAngles(var paths: TList; iLo, iHi: Integer);
var
Lo, Hi: Integer;
Mid: TnetPath;
begin
Lo := iLo;
Hi := iHi;
Mid := TnetPath(Paths[(Lo + Hi) div 2]);
repeat
while TNetPath(Paths[Lo]).Angle < Mid.Angle do
Inc(Lo);
while TNetPath(Paths[Hi]).Angle > Mid.Angle do
Dec(Hi);
if Lo <= Hi then
begin
Paths.Exchange(Lo,Hi);
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then
SortPathAngles(paths, iLo, Hi);
if Lo < iHi then
SortPathAngles(paths, Lo, iHi);
end;
function TNet.GetAp1: TDoublePoint;
begin
Result := inherited GetAp1;
if Points.Count > 0 then
Result := PDoublePoint(Points[0])^;
end;
function TNet.AddPath(p1, p2: PDoublePOint;Border:Boolean): TNetPath;
var
path: TNetPath;
i: Integer;
begin
Result := nil;
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(Paths[i]);
if path.AreYou(p1, p2) then
begin
result := path;
exit;
end;
end;
path := TNetPath.Create(p1, p2, Border, self);
paths.Add(path);
result := path;
RefreshColPositions;
end;
Function TNet.AddPoint(p: TDoublePoint; aTrgPath: TNetPath=nil): PDoublePoint;
var
xp: PDoublePoint;
pointID: Integer; //04.10.2010
begin
result := nil;
New(xp);
xp.x := p.x;
xp.y := p.y;
Points.Add(xp);
////#From Oleg# //04.10.2010
pointID := 0;
if Assigned(FOnAddPoint) then
pointID := FOnAddPoint(Self, aTrgPath, xp, 0);
FPointIDs.Add(Pointer(pointID));
Result := xp;
end;
procedure TNet.ArcSelPath;
var
index: Integer;
path: TNetPath;
begin
if (SelType = stPath) and (SelIndex > 0) then
begin
index := SelIndex-1;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
Path.isArc := not path.isArc;
RefreshPaths;
end;
end;
end;
procedure TNet.CalculatePathPoints;
var
i: Integer;
path: TNetPath;
begin
for i := 0 to paths.Count - 1 do
begin
path := TnetPath(Paths[i]);
Path.CalculatePoints(50,0);
end;
end;
procedure TNet.Clear;
var
p: PDoublePOint;
i: integer;
begin
try
for i := 0 to Points.Count- 1 do
begin
p := PDoublePOint(Points[i]);
Dispose(p);
end;
Points.Clear;
for i := 0 to Paths.Count - 1 do
begin
TNetPath(Paths[i]).Free;
end;
Paths.Clear;
for i := 0 to Structs.Count - 1 do
begin
TNetStruct(Structs[i]).Free;
end;
Structs.Clear;
except
// ShowMessage(CPowerCadMessage + 'TNet.Clear');
end;
end;
function TNet.CountPathsOfKnot(p: PDoublePoint; lPaths: Tlist): Integer;
var
i,cnt: Integer;
begin
result := 0;
cnt := 0;
for i := 0 to lPaths.Count-1 do
begin
if TnetPath(lPaths[i]).isKnotIn(p) > 0 then
begin
cnt := cnt + 1;
end;
end;
result := cnt;
end;
constructor TNet.create(LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent);
begin
PathRgn := 0; // íå ïðîèíèöèàëèçèðîâàíî íèãäå, íî óäàëÿåòñÿ â íåêîòîðûõ ìåñòàõ ... ìîæåò íàäåëàòü áÿê...
//
inherited Create(LHandle,aDrawStyle,aOwner);
initialize;
if assigned(owner) then
begin
MapScale := TPCDrawing(Owner).MapScale;
if TPCDrawing(Owner).RulerMode = rmPage then
WorldDim := False
else
if TPCDrawing(Owner).RulerMode = rmWorld then
WorldDim := True;
xDrawEngine := TPCDrawing(Owner).DEngine;
WorkHeight := TPCDrawing(Owner).WorkHeight;
WorkWidth := TPCDrawing(Owner).WorkWidth;
end;
WallThick := 4;
SelType := stPath;
SelIndex := 0;
FillWalls := False;
IsometricUpdate := False;
//FID := 0;
FCmpPointPrecision := -1;
FComponID := 0;
FDeleting := false;
FDisableMergePaths := false;
FFigureModification := false; //#From Oleg#
FMoveAllPoints := false;
FOnAddPoint := nil;
FOnAutoAddPath := nil;
FOnDefineJoinedNets := nil; //26.05.2011
FOnDefineMoveObjects := nil; //23.05.2011
FOnDelete := nil;
FOnDeletePoint := nil;
FOnDuplicate := nil; //16.05.2011
FOnMergePaths := nil;
FOnMergePathsQuery := nil; //21.10.2010
FOnMergeNetPathsQuery := nil;
FOnMergeNetsQuery := nil; //21.10.2010
FOnMove := nil; //09.06.2011
FOnMoveJoinedPoints := nil; //09.06.2011
FOnMovePoint := nil; //29.04.2011
FOnPathsOverlapQuery := nil; //10.05.2011
FOnResize := nil;
FOnScale := nil; //27.05.2011
FOnScaleAfter := nil; //10.06.2011
FOnScaleBefore := nil; //10.06.2011
FOnSetScale := nil; //27.12.2010
FOnSelectPoint := nil;
FPathDivision := nil; //26.03.2013
GArchEngine.SetHandlersToObj(Self);
RefreshPaths;
end;
class function TNet.CreateFromShadow(aOwner: TComponent; LHandle: Integer;
Shadow: TFigure): TFigure;
var
cad: TPCDrawing;
begin
Result := nil;
cad := TPCDrawing(aOwner);
Result := TNet.create(LHandle, mydsNormal, aOwner);
TNet(Result).XDrawEngine := cad.DEngine;
end;
function TNet.CreateModification: TFigure;
var
Res: Tnet;
pIdx: Integer;
path: TnetPath;
mp: PdoublePoint;
cp: TDoublePoint;
ap1, ap2: TDoublePoint;
Door: TNetDoor; //11.10.2010
RelNets: TList; //19.10.2010
RelNet: TNet;
RelDupNet: TNet;
RelPt: PDoublePoint;
Net: TNet;
NetList: TList;
i, j: integer; //19.10.2010
begin
result := nil;
FFigureModification := true; //#From Oleg#
FLastTickTraceRefresh := 0; //24.05.2011
Self.ClearRels; //21.10.2010
{$ifndef limited}
if assigned(TracePoint) then
begin
pIdx := TracePoint.SeqNbr;
if (TracePoint.PType = ptPolyPoint) and (pIdx > -1) and (pIdx < (Points.Count)) then
begin
//TracePoint.FIsDrag := true;
mp := PDoublePoint(Points[pIdx]);
Res := DuplicateByKnot(mp, true);
TracePoint.Tag := res.PointIndex(mp^);
Result := res;
//19.10.2010
RelNets := GetRelatedNetsByPoints(mp, nil, citNone, true);
if RelNets <> nil then
begin
for i := 0 to RelNets.Count - 1 do
begin
RelNet := TNet(RelNets[i]);
RelNet.FRelatedMPoint := RelNet.GetPointByNear(mp^);
Self.FRelatedNets.Add(RelNet);
RelDupNet := nil;
if RelNet.FRelatedPoints.Count > 0 then
RelDupNet := RelNet.DuplicateByKnot(PDoublePoint(RelNet.FRelatedPoints[0]), true)
else if CanMoveJoined then
begin
RelDupNet := TNet(RelNet.duplicate);
RelDupNet.SetPathsHidden(true); // ïîêà ñêðûâàåì âñå ñåãìåíòû, òàê êàê åñëè íå íàéäóòñÿ ñâÿçàííûå òî÷êè, òî íåòó íåîáõîäèìîñòè èõ îòðèñîâûâàòü
end;
if RelDupNet <> nil then
begin
RelDupNet.FRelatedMPoint := RelDupNet.GetPointByNear(mp^);
RelDupNet.DrawStyle := dsTrace;
RelDupNet.color := clLime;
RelDupNet.Style := 1;
RelDupNet.width := 1;
RelDupNet.Brs := 1;
RelDupNet.FRelatedOwner := Res;
TNet(Res).FRelatedNets.Add(RelDupNet);
for j := 0 to RelNet.FRelatedPoints.Count - 1 do
begin
RelPt := RelDupNet.GetPointByNear(PDoublePoint(RelNet.FRelatedPoints[j])^);
if RelPt <> nil then
RelDupNet.FRelatedPoints.Add(RelPt);
end;
end;
end;
RelNets.Free;
end;
// Îïðåäåëèòü äîï. òî÷êè äëÿ ïåðåìåùåíèÿ
if Assigned(FOnDefineMoveObjects) then
begin
NetList := Tlist.Create;
NetList.Assign(TNet(Res).FRelatedNets);
NetList.Insert(0, Res);
if FOnDefineMoveObjects(Self, mp, nil, NetList) then
for i := 0 to NetList.Count - 1 do
begin
Net := TNet(NetList[i]);
Net.SetPathsHidden(false);
Net.SavePoints;
end;
NetList.Free;
end;
end
else
if (TracePoint.PType = ptRectPoint) and (pIdx > -1) and (pIdx < Paths.Count) then
begin
Path := TNetPath(Paths[pIdx]);
Res := DuplicateByPath(Path);
TracePoint.Tag := res.PathIndex(path.p1^, path.p2^);
Result := res;
end
else
if (TracePoint.PType = ptGroupPoint) and (pIdx > -1) and (pIdx < Paths.Count) then
begin
Path := TnetPath(Paths[pIdx]);
Res := DuplicateByPath(Path, True, True); //22.04.2011 Res := DuplicateByPath(Path, True);
Res.RefreshPaths; //22.04.2011
Res.DefineInOutPoints; //22.04.2011
TracePoint.Tag := res.PathIndex(path.p1^, path.p2^);
Result := res;
end
else
//11.10.2010
if (TracePoint.PType = ptControlPoint) then
begin
//Path := TnetPath(Paths[pIdx]);
//Res := DuplicateByPath(Path, True);
//TracePoint.Tag := res.PathIndex(path.p1^, path.p2^);
//Result := res;
Door := GetSelPathChild; //Path.ActiveDoor;
Result := TDoorTrace.Create(Self, Door.GetPath, Door);
TDoorTrace(Result).FIsShowLen := true;
end
else
//22.10.2010
if TracePoint.PType = ptArcControl then
begin
Path := TnetPath(Paths[pIdx]);
Res := DuplicateByPath(Path, True, True);
Res.RefreshPaths;
Res.DefineInOutPoints;
TracePoint.Tag := res.PathIndex(path.p1^, path.p2^);
Result := res;
end;
end
else
begin
Result := CreateMoveTrace;
Tpowercad(Owner).SnapLocked := True;
exit;
end;
if not assigned(result) then
begin
res := DuplicateByBorder;
Result := res;
end;
if assigned(Result) then
begin
Result.DrawStyle := dsTrace;
Result.color := clLime;
Result.Style := 1;
Result.width := 1;
Result.Brs := 1;
end;
{$endif limited}
end;
Function TNet.CheckDeleteInnerWalls(aCanDeleteWalls: Boolean): Boolean;
var i: Integer;
CanDelPath: Boolean;
PathCompon: TSCSComponent;
currPath: TNetPath;
NetConture: TDoublePointArr;
begin
Result := True;
CanDelPath := True;
While CanDelPath do
begin
CanDelPath := False;
if Paths.Count > 3 then
begin
for i := 0 to Paths.Count - 1 do
begin
currPath := TNetPath(Paths[i]);
if currPath.FComponID > 0 then
begin
PathCompon := Nil;
PathCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(currPath.FComponID);
if (PathCompon <> nil) and (PathCompon.IsLine = ctArhWallDivision) then
begin
// åñëè ïåðåãîðîäêà îêàçàëàñü âíå êîíòóðà -- óäàëèòü åå
SetLength(NetConture,0);
NetConture := Self.GetRoomConture(self.Paths);
if ((not PtInPolygon(NetConture, currPath.p1^)) or
(not PtInPolygon(NetConture, currPath.p2^))) then
begin
if not aCanDeleteWalls then
Result := False
else
begin
DeletePath(currPath);
CanDelPath := True;
break;
end;
end;
SetLength(NetConture,0);
end;
end;
end;
end;
end;
end;
Function TNet.DeletePath(Path: TnetPath):Boolean;
var
i: Integer;
PathCompon: TSCSComponent;
SCSList: TSCSList;
ArchContainer: TSCSCatalog;
ArchRoom: TSCSComponent;
isP1, isP2: Boolean;
// 02/02/2017 -- Tolik
InnerWallDelete: Boolean;
//
procedure CheckInterSection;
var i: Integer;
CanDelPath: Boolean;
currPath, ConnectedPath: TNetPath;
begin
CanDelPath := True;
ConnectedPath := nil;
While CanDelPath do
begin
CanDelPath := False;
if Paths.Count > 2 then
begin
for i := 0 to Paths.Count - 1 do
begin
currPath := TNetPath(Paths[i]);
if currPath.FComponID > 0 then
begin
PathCompon := Nil;
PathCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(currPath.FComponID);
if (PathCompon <> nil) and (PathCompon.IsLine = ctArhWallDivision) then
begin
// åñëè ïåðåãîðîäêà îêàçàëàñü âíå êîíòóðà -- óäàëèòü åå
if ((not PtInPolygon(Self.GetRoomConture, currPath.p1^)) or
(not PtInPolygon(Self.GetRoomConture, currPath.p2^))) then
begin
DeletePath(currPath);
Break; //// BREAK ////;
end;
end;
end;
end;
end;
end;
end;
//
begin
result := false;
InnerWallDelete := False;
if assigned(UndoProc) then
UndoProc;
// Tolik -- 02/02/2017 --
// åñëè óäàëÿåòñÿ ïåðåãîðîäêà -- âûñòàâèòü ôëàæîê
if Path.FComponID > 0 then
begin
PathCompon := Nil;
PathCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(Path.FComponID);
if (PathCompon <> nil) and (PathCompon.IsLine = ctArhWallDivision) then
InnerWallDelete := True;
end;
//
path.DoDelete; //04.06.2010
Paths.Remove(path);
{CombinePathsOfKnot(path.p1);
CombinePathsOfKnot(path.p2);}
RefreshPoints;
path.free;
RefreshColPositions;
RefreshPaths;
result := true;
// Tolik -- 01/02/2017 --
// ïðîâåðèòü ïåðåãîðîäêè êîìíàò ïîñëå îáúåäèíåíèÿ
// òå, êîòîðûå âûëåçóò çà êîíòóð - óäàëèòü íàôèã
if not InnerWallDelete then
InnerWallDelete := CheckDeleteInnerWalls(True);
//
end;
destructor TNet.Destroy;
var
MethodName: String;
i: Integer;
RelNet: TNet;
begin
FDeleting := true; //25.06.2012
MethodName := 'Destroy';
try
// Åñëè ýòî äóáëèêàò äëÿ Shadow
if (FSrcNet <> nil) and (DrawStyle = dsTrace) then
begin
FSrcNet.FFigureModification := false;
if FSrcNet.FRelatedNets.Count > 0 then
FSrcNet.FRelatedNets.Clear;
end;
// Î÷èùàåì ñâÿçàííûå îáúåêòû, åñëè ýòîò ÿâëÿåòñÿ âëàäåëüöåì
for i := 0 to FRelatedNets.Count - 1 do
begin
RelNet := TNet(FRelatedNets[i]);
if RelNet.FRelatedOwner = Self then
RelNet.Free;
end;
except
on E: Exception do AddExceptionToLogExt(ClassName, MethodName, E.Message);
end;
ClearPaths;
ClearNetPoints;
ClearStructs;
Paths.Free;
Points.Free;
Structs.Free;
//Tolik
// DeleteObject(PathRgn);
if PathRgn <> 0 then
DeleteObject(PathRgn);
//
try
FSelection.Free; //27.07.2011
// join Igor 2016-10-11
FRelatedNets.Clear;
// join Igor 2016-10-11 end
FPointIDs.Free; //04.10.2010
FRelatedPoints.Free; //18.10.2010
FRelatedNets.Free; //19.10.2010
FJoinedMovePoints.Free; //23.05.2011
FJoinedMovePointsDirections.Free; //23.05.2011
FJoinedMovePointsFixedState.Free; //27.05.2011
FJoinedMovePaths.Free; //24.05.2011
FJoinedMovePathsDirections.Free; //24.05.2011
FDrawedPt1.Free; //13.05.2011
FDrawedPt2.Free; //13.05.2011
ClearSavedPoints;
ClearSavedScaledPoints;
FSavedPoints.Free;
FSavedScaledPoints.Free;
except
on E: Exception do AddExceptionToLogExt(ClassName, MethodName, E.Message);
end;
inherited;
end;
procedure TNet.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
acolor,bcolor : Tcolor;
i,j,sw,sh: Integer;
path: TnetPath;
Struct: TnetStruct;
cp,xp: TDoublePOint;
rgn: HRGN;
tl,th: Double;
iStart: Integer;
xrgn: HRGN;
MainNet: TNet;
NetSelPath: TNetPath;
CanDrawPath: Boolean;
begin
FDrawedPt1.Clear;
FDrawedPt2.Clear;
DrawRelated(DEngine, isGrayed);
if not isGrayed then
Self.DrawGuides := false
else
Self.DrawGuides := True;
try
iStart := 0
except
exit;
end;
try
if (DrawSTyle = mydsNormal) then
begin
if Modified then
begin
Modified := False;
UpdateAllRegions(Dengine);
end;
end;
except
exit;
end;
if DrawStyle = dsTrace then
begin
// DEngine.Canvas.Pen.Mode := pmXor;
end
else
DEngine.Canvas.Pen.Mode := pmCopy;
if (DrawSTyle = mydsNormal) and (not isGrayed) and (FillWalls) then
begin
DEngine.Canvas.Brush.Style := bsSolid;
DEngine.Canvas.Brush.Color := RGB(240, 240, 240);
FillRgn(DEngine.Canvas.Handle,PathRgn,DEngine.Canvas.Brush.Handle);
end;
acolor := color;
bColor := brc;
if (aColor = -255) and (LayerHandle <> 0) then
begin
aColor := TLayer(LayerHandle).PenColor;
end;
if (bColor = -255) and (LayerHandle <> 0) then
begin
bColor := TLayer(LayerHandle).BrushColor;
end;
if (isGrayed) //or (Isometric)
then
begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
bcolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if DrawStyle = mydsNormal then
begin
try
for i := iStart to Structs.Count - 1 do
begin
Struct := TnetStruct(Structs[i]);
if DrawAsTrace then
Struct.Style := ord(psSolid)
else
Struct.Style := ord(psSolid);
Struct.Draw(DEngine,isGrayed);
end;
except
exit;
end;
rgn := 1;
Sw := 0;
Sh := 0;
if assigned(owner) then
begin
Sw := TPCDrawing(Owner).SurfaceWidth;
sh := TPCdrawing(Owner).SurfaceHeight;
end;
try
NetSelPath := Self.SelPath;
for i := iStart to paths.Count - 1 do
begin
path := TnetPath(paths[i]);
if Path <> NetSelPath then
begin
path.Tag := i;
if DrawAsTrace then
path.Style := ord(psSolid)
else
path.Style := ord(psSolid);
path.Draw(DEngine,aColor);
end;
end;
if NetSelPath <> nil then //22.08.2011
begin
NetSelPath.Tag := i;
if DrawAsTrace then
NetSelPath.Style := ord(psSolid)
else
NetSelPath.Style := ord(psSolid);
NetSelPath.Draw(DEngine,aColor);
end;
except
exit;
end;
end
else
begin
try
for i := iStart to paths.Count - 1 do
begin
path := TnetPath(Paths[i]);
path.Tag := i;
CanDrawPath := false;
if Self.FindPathInRelatedNearPoints(path.p1, path.p2) = nil then //19.10.2010 - ÷òîáû íå ïðîðèñîâàòü îäíó ëèíèþ íåñêîëüêî ðàç
CanDrawPath := true;
{if CanDrawPath then
begin
if Assigned(FRelatedOwner) and (FRelatedOwner is TPathTrace) then
//if (Length(TPathTrace(FRelatedOwner).NPoints1) > 0) and (Length(TPathTrace(FRelatedOwner).NPoints1) > 0) then
if TPathTrace(FRelatedOwner).IsRelatedTo(path.p1, path.p2) then
begin
CanDrawPath := false;
//for i := 0 to Length(TPathTrace(FRelatedOwner).NPoints1) - 1 do
//begin
// if CmpIntersectPaths(path.p1, path.p2, @TPathTrace(FRelatedOwner).NPoints1[0], @TPathTrace(FRelatedOwner).NPoints2[0]) = citEqual then
// CanDrawPath := false;
//end;
end;
end;}
//if Assigned(FRelatedOwner) then
//begin
// if FRelatedOwner is TNet then
// CanDrawPath := Not TNet(FRelatedOwner).IsPathDrawed(path.p1, path.p2)
// else if FRelatedOwner is TPathTrace then
// begin
// if Assigned(TPathTrace(FRelatedOwner).Clone) then
// CanDrawPath := Not TPathTrace(FRelatedOwner).Clone.IsPathDrawed(path.p1, path.p2)
// else
// EmptyProcedure;
// end;
//end
//else
// CanDrawPath := Not IsPathDrawed(path.p1, path.p2);
MainNet := GetMainTraceNet;
if MainNet <> nil then
CanDrawPath := Not MainNet.IsPathDrawed(path.p1, path.p2);
if CanDrawPath then
path.DrawTrace(DEngine);
end;
for i := iStart to Structs.Count-1 do
begin
Struct := TnetStruct(Structs[i]);
Struct.DrawTrace(DEngine);
end;
except
exit;
end;
end;
end;
procedure TNet.drawselectionpoints(DEngine: TPCDrawEngine;
isGrayed: Boolean);
var
index,i: Integer;
reg: HRGN;
Path, SelPath: TNetPath;
begin
inherited;
if IsDrawingDetail then
exit;
if (SelType = stPath) and (SelIndex > 0) then
begin
index := SelIndex - 1;
if index > Paths.Count - 1 then
index := 0
else
begin
//25.03.2013 TNetPath(Paths[Index]).Hatch(Dengine,isGrayed);
//25.03.2013
{if FSelection.Count > 1 then
begin
Path := TNetPath(Paths[Index]);
for i := 0 to FSelection.Count - 1 do
begin
SelPath := TNetPath(FSelection[i]);
if (SelPath <> path) and (Paths.IndexOf(SelPath) <> -1) then
SelPath.Hatch(Dengine,isGrayed);
end;
end;}
for i := 0 to FSelection.Count - 1 do
begin
SelPath := TNetPath(FSelection[i]);
if Paths.IndexOf(SelPath) <> -1 then
SelPath.Hatch(Dengine,isGrayed);
end;
end;
end
else
if (SelType = stStruct) and (SelIndex > 0) then
begin
index := SelIndex - 1;
if index > Structs.Count - 1 then
index := 0
else
TNetStruct(Structs[Index]).Hatch(Dengine,isGrayed);
end;
end;
function TNet.duplicate: TFigure;
var
Res: TNet;
i,k: Integer;
path, xPath: TNetPath;
pId: Integer;
p1,p2: PDoublePoint;
pt1: TnetPath;
begin
Result := nil;
Res := Tnet.Create(LayerHandle, DrawStyle, Owner);
Res.FSrcNet := Self; //21.10.2010
Res.MapScale := MapScale;
Res.WorldDim := WorldDim;
Res.Clear;
For i := 0 to Points.Count - 1 do
begin
p1 := PDoublePoint(points[i]);
res.AddPoint(p1^);
end;
for i := 0 to Paths.Count - 1 do
begin
p1 := nil;
p2 := nil;
xPath := nil; //#From Oleg# //14.09.2010
path := TNetPath(paths[i]);
pId := Points.IndexOf(path.p1);
if (pId > -1) and (pId < res.Points.Count) then
p1 := PDoublePoint(res.Points[pId]);
pId := Points.IndexOf(path.p2);
if (pId > -1) and (pId < res.Points.Count) then
p2 := PDoublePoint(res.Points[pId]);
if assigned(p1) and assigned(p2) then
xPath := res.AddPath(p1,p2,path.Border);
//if assigned(xPath) then
// xPath.Info := Path.Info;
//if assigned(xPath) then
// xPath.Width := Path.Width;
if assigned(xPath) then
begin
xPath.Info := Path.Info;
xPath.Width := Path.Width;
xPath.AssignProps(Path);
xPath.Opath := path;
end;
end;
Tnet(Res).WallThick := WallThick;
Tnet(Res).EndDraw := EndDraw;
Tnet(Res).ContextMenu := ContextMenu;
Tnet(Res).DrawGuides := DrawGuides;
Tnet(Res).EditMode := EditMode;
Tnet(Res).FComponID := FComponID; //23.05.2011
Result := res;
end;
function TNet.DuplicateByBorder: TNet;
var
Res: TNet;
i: Integer;
path: TNetPath;
pList:TList;
pId: Integer;
p1,p2: PDoublePoint;
begin
Result := nil;
Res := Tnet.Create(LayerHandle, DrawStyle, owner);
Res.FSrcNet := Self; //21.10.2010
Res.MapScale := MapScale;
Res.WorldDim := WorldDim;
Res.Clear;
pList := TList.Create;
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(paths[i]);
if path.Border then
begin
pId := pList.IndexOf(path.p1);
if pId = -1 then
begin
pList.Add(path.p1);
p1 := res.AddPoint(path.p1^);
end
else
begin
p1 := PDoublePoint(res.Points[pId]);
end;
pId := pList.IndexOf(path.p2);
if pId = -1 then
begin
pList.Add(path.p2);
p2 := res.AddPoint(path.p2^);
end
else
begin
p2 := PDoublePoint(res.Points[pId]);
end;
Res.AddPath(p1,p2,true);
end;
end;
pList.Free;
Result := res;
end;
function TNet.DuplicateByKnot(p: PDoublePoint; AAllPaths: Boolean=false): Tnet;
var
Res: TNet;
i: Integer;
path: TNetPath;
pList: TList;
pId: Integer;
p1,p2,xp: PDoublePoint;
Struct,dStruct: TNetStruct;
k: Integer;
NewPath: TNetPath; //21.10.2010
//ShowPathLengthType: TShowPathLengthType;
begin
Result := nil;
Res := Tnet.Create(LayerHandle, DrawStyle, owner);
Res.FSrcNet := Self; //21.10.2010
Res.Clear;
Res.MapScale := MapScale;
Res.WorldDim := WorldDim;
pList := TList.Create;
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(paths[i]);
if AAllPaths or (path.isKnotIn(p) > 0) then
begin
pId := pList.IndexOf(path.p1);
if pId = -1 then
begin
pList.Add(path.p1);
p1 := res.AddPoint(path.p1^);
end
else
begin
p1 := PDoublePoint(res.Points[pId]);
end;
pId := pList.IndexOf(path.p2);
if pId = -1 then
begin
pList.Add(path.p2);
p2 := res.AddPoint(path.p2^);
end
else
begin
p2 := PDoublePoint(res.Points[pId]);
end;
//21.04.2011
//ShowPathLengthType := sltPoints;
//if Assigned(path.FOnGetShowPathTraceLengthType) then
// ShowPathLengthType := path.FOnGetShowPathTraceLengthType(path);
//case ShowPathLengthType of
// sltInner:
// begin
// path.DefineInOutPoints;
// if path.p1 <> p then
// begin
// p1^ := path.ip1^;
// PointToLine(path.p1^, path.p2^, p1^.x, p1^.y);
// end;
// if path.p2 <> p then
// begin
// p2^ := path.ip2^;
// PointToLine(path.p1^, path.p2^, p2^.x, p2^.y);
// end;
// end;
// sltOuter:
// begin
// path.DefineInOutPoints;
// if path.p1 <> p then
// begin
// p1^ := path.op1^;
// PointToLine(path.p1^, path.p2^, p1^.x, p1^.y);
// end;
// if path.p2 <> p then
// begin
// p2^ := path.op2^;
// PointToLine(path.p1^, path.p2^, p2^.x, p2^.y)
// end;
// end;
//end;
NewPath := Res.AddPath(p1,p2,true);
NewPath.FComponID := path.FComponID;
//22.10.2010
NewPath.AssignProps(path);
//19.04.2011
if AAllPaths then
begin
//NewPath.Opath := path;
NewPath.FIsInner := path.FIsInner;
//21.04.2011
NewPath.FIsHidden := Not (path.isKnotIn(p) > 0);
end;
end;
end;
for i := 0 to Structs.Count - 1 do
begin
Struct := TNetStruct(Structs[i]);
if Struct.IsKnotIn(p) > -1 then
begin
dStruct := Struct.DuplicateNonPoints;
For k := 0 to Struct.Points.Count -1 do
begin
xp :=PDoublePoint(Struct.Points[k]);
if assigned(xp) then
begin
pId := pList.IndexOf(xp);
if pId = -1 then
begin
pList.Add(xp);
p1 := res.AddPoint(xp^);
dStruct.Points.Add(p1);
end
else
begin
p1 := PDoublePoint(res.Points[pId]);
dStruct.Points.Add(p1);
end;
end;
end;
Res.Structs.Add(dStruct);
end;
end;
pList.Free;
//21.04.2011
if AAllPaths then
begin
Res.RefreshPaths;
// Îïðåäåëÿåì âíóòð/âíåøí òî÷êè ÷òîáû íå îïðåäåëÿòü êàæäûé ðàç íà TraceModification
Res.DefineInOutPoints;
end;
Res.FComponID := FComponID; //21.10.2010
Result := res;
end;
function TNet.DuplicateByPath(p: TNetPath; Group: Boolean = False; AAllPaths: Boolean=false): Tnet;
var
Res: TNet;
i: Integer;
path,lPath,xPath: TNetPath;
pList:TList;
pId: Integer;
p1,p2: PDoublePoint;
rad,prad: Double;
xPaths,fPaths:Tlist;
done,found: Boolean;
Heught1,Heught2: double;
begin
Result := nil;
Res := Tnet.Create(LayerHandle, DrawStyle, owner);
Res.FSrcNet := Self; //21.10.2010
Res.Clear;
Res.MapScale := MapScale;
Res.WorldDim := WorldDim;
pList := TList.Create;
fPaths := TList.Create;
if Group then
begin
done := false;
rad := GetRadOfLine(p.p1^,p.p2^);
xPaths := TList.Create;
lPath := p;
p1 := p.p1;
repeat
xPaths.Clear;
GetPathsOfKnot(p1,xPaths);
xPaths.Remove(lPath);
found := false;
for i := 0 to xPaths.Count - 1 do
begin
path := TNetPath(xPaths[i]);
Heught1 := GetZPoint(path.Net,path.p1);
Heught2 := GetZPoint(path.Net,path.p2);
if (EQDP(path.p1^,path.p2^))and(Heught1 <> Heught2)and(IfFiguraIsRoof(path.Net)) then
begin
found := false;
fPaths.Add(path);
break;
end
else
begin
prad := GetRadOfLine(path.p1^,path.p2^);
if not Eqd(rad,prad) then
prad := GetRadOfLine(path.p2^,path.p1^);
if eqd(rad,prad) then
begin
fPaths.Add(path);
p1 := path.OtherPoint(p1);
lPath := path;
found := true;
if fPaths.Count > 200 then
begin
fPaths.Clear;
break;
end;
end
else
fPaths.Add(path);
end;
end;
until (not found) or (xPaths.Count = 0);
p1 := p.p2;
lPath := p;
repeat
xPaths.Clear;
GetPathsOfKnot(p1,xPaths);
xPaths.Remove(lPath);
found := false;
for i := 0 to xPaths.Count - 1 do
begin
path := TNetPath(xPaths[i]);
Heught1 := GetZPoint(path.Net,path.p1);
Heught2 := GetZPoint(path.Net,path.p2);
if (EQDP(path.p1^,path.p2^))and(Heught1 <> Heught2)and(IfFiguraIsRoof(path.Net)) then
begin
found := false;
fPaths.Add(path);
break;
end
else
begin
prad := GetRadOfLine(path.p1^,path.p2^);
if not Eqd(rad,prad) then
prad := GetRadOfLine(path.p2^,path.p1^);
if eqd(rad,prad) then
begin
fPaths.Add(path);
p1 := path.OtherPoint(p1);
lPath := path;
found := true;
if fPaths.Count > 200 then
begin
fPaths.Clear;
break;
end;
end
else
fPaths.Add(path);
end;
end;
until (not found) or (xPaths.Count = 0);
xPaths.free;
end;
for i := 0 to FPaths.Count - 1 do
begin
path := TNetPath(fpaths[i]);
pId := pList.IndexOf(path.p1);
if pId = -1 then
begin
pList.Add(path.p1);
p1 := res.AddPoint(path.p1^);
end
else
begin
p1 := PDoublePoint(res.Points[pId]);
end;
pId := pList.IndexOf(path.p2);
if pId = -1 then
begin
pList.Add(path.p2);
p2 := res.AddPoint(path.p2^);
end
else
begin
p2 := PDoublePoint(res.Points[pId]);
end;
xPath := Res.AddPath(p1,p2,true);
xPath.Opath := path;
xPath.AssignProps(path); //22.10.2010
end;
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(paths[i]);
if AAllPaths or ((Fpaths.IndexOf(path) = -1) and path.Connected(p)) then
begin
pId := pList.IndexOf(path.p1);
if pId = -1 then
begin
pList.Add(path.p1);
p1 := res.AddPoint(path.p1^);
end
else
begin
p1 := PDoublePoint(res.Points[pId]);
end;
pId := pList.IndexOf(path.p2);
if pId = -1 then
begin
pList.Add(path.p2);
p2 := res.AddPoint(path.p2^);
end
else
begin
p2 := PDoublePoint(res.Points[pId]);
end;
xPath := Res.AddPath(p1,p2,true);
xPath.Opath := path;
xPath.AssignProps(path); //22.10.2010
//22.04.2011
if AAllPaths then
begin
xPath.FIsInner := path.FIsInner;
xPath.FIsHidden := Not path.Connected(p);
end;
end;
end;
pList.Free;
fPaths.Free;
Res.FComponID := FComponID; //21.10.2010
Result := res;
end;
procedure TNet.EditArcAng;
var
index: Integer;
path: TNetPath;
ang: double;
begin
if (SelType = stPath) and (SelIndex > 0) then
begin
index := SelIndex-1;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
if path.isArc then
begin
ang := Path.ArcAng*(180/pi); // Ïðåîáðàçîâàíèå â ãðàä
if InputDouble('TNet.EditArcAng','TNet.EditArcAng',ang) then
begin
Path.ArcAng := (ang/180)*pi;
RefreshPaths;
end;
end;
end;
end;
end;
function TNet.EndModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean;
var
p: PDoublePoint;
dx, dy: Double;
path : TNetPath;
index: Integer;
CanMergePaths: Boolean;
StartPt: TDoublePoint;
procedure NormalizePoint;
var
pt: TDoublePoint;
begin
if Not (ssShift in GGlobalShiftState) then //12.10.2010
begin
pt := PointToOrthogonal(p, x, y, Self); //12.10.2010
x := pt.x; //12.10.2010
y := pt.y; //12.10.2010
end;
end;
begin
FFigureModification := false; //#From Oleg#
result := false;
if not assigned(TraceFigure) then
Exit;
TPowerCad(Owner).SnapLocked := False;
if (mp.PType = ptPolyPoint) and (mp.SeqNbr > -1) and (mp.SeqNbr < Points.Count) then
begin
// SnapModPoint(x, y, mp, Tnet(TraceFigure));
p := PDoublePoint(Points[mp.SeqNbr]);
StartPt := p^;
if TNet(TraceFigure).Paths.Count = 1 then
begin
//#From Oleg#
CanMergePaths := true;
if Assigned(FOnMergeNetPathsQuery) then
FOnMergeNetPathsQuery(Self, CanMergePaths);
if CanMergePaths then
LocatePathPoint(p, x, y)
else
begin
NormalizePoint; //15.10.2010
LocatePoint(p, x, y);
end;
end
else
begin
NormalizePoint; //15.10.2010
LocatePoint(p, x, y);
end;
// Ñìîòðèì íàñêîëüêî áûëà ïåðåìåùåíà òî÷êà ÷åðåç PointToOrthogonal
if GetLineLenght(StartPt, p^) > 1 then
begin
EmptyProcedure;
end;
// NormalizeKnot(p, Self);
end
else
if (mp.PType = ptRectPoint) then
begin
index := (mp.SeqNbr);
if (index > -1) and (index < Paths.Count) then
begin
SnapModPoint(x, y, mp, Tnet(TraceFigure));
dx := x - mp.coordx;
dy := y - mp.coordy;
Path := TnetPath(Paths[index]);
MovePath(Path, dx, dy);
end;
end
else
if (mp.PType = ptGroupPoint) then
begin
index := (mp.SeqNbr);
if (index > -1) and (index < Paths.Count) then
begin
SnapModPoint(x, y, mp, Tnet(TraceFigure));
dx := x - mp.coordx;
dy := y - mp.coordy;
Path := TnetPath(Paths[index]);
MoveSatih(path, dx, dy, True);
RefreshPaths;
Path.Net.DoResize;
end;
end
else
if (mp.PType = ptControlPoint) and (mp.SeqNbr > 0) then
begin
TDoorTrace(TraceFigure).EndTrace;
end
//11.10.2010
else
if (mp.PType = ptControlPoint) and (mp.SeqNbr = -3) then
begin
TDoorTrace(TraceFigure).EndTrace;
end
//22.10.2010
else
if mp.PType = ptArcControl then
begin
Path := TnetPath(TNet(TraceFigure).Paths[mp.Tag]);
Path.Opath.ArcAng := Path.ArcAng;
Path.Opath.ArcCenter := Path.ArcCenter;
Path.Opath.Refresh;
// òî÷êó ñòàâèì ïåðïåíäèêóëÿðíî Path
//PointToLine(Path.p1^, Path.p2^, x, y);
//Path.ArcCenter := DoublePoint(x, y);
//Path.ArcAng := GetRadOf2Lines(Path.p1^, Path.ArcCenter, Path.p2^);
//tf.CalculatePathPoints;
//CalculatePathPoints;
RefreshPaths;
Path.Net.DoResize; //17.12.2010
end;
end;
procedure TNet.SetModified;
begin
ResetRegion;
FIsLoadedBounds := false; //03.02.2012
end;
function TNet.FindBrokenPath(xPaths: TList): TnetPath;
var
i: Integer;
Path: TnetPath;
p1: pDoublePoint;
p2: pDoublePoint;
cnt1: Integer;
cnt2: Integer;
begin
result := nil;
for i := 0 to xPaths.Count - 1 do
begin
Path := TnetPath(xPaths[i]);
p1 := path.p1;
p2 := path.p2;
cnt1 := CountIntersectingPathsOfKnot(p1,xPaths);
cnt2 := CountIntersectingPathsOfKnot(p2,xPaths);
if cnt1 = 1 then
Path.DeadIdx := 1;
if cnt2 = 1 then
Path.DeadIdx := 2;
if (cnt1 = 1) or (cnt2=1) then
begin
result := Path;
end;
end;
end;
function TNet.FindClockPath(cPaths:TList;p: PDoublePoint;oPath:TnetPath): TNetPath;
var
xp: pDoublePoint;
xPaths: TList;
i: Integer;
path,xPath: TnetPath;
angle: Double;
mAng: Double;
oAngle : Double;
begin
result := nil;
xPaths := TList.Create;
GetPathsOfKnot(p,cPaths,xpaths);
xPath := nil;
xp := opath.OtherPoint(p);
oAngle := GetRadOfLine(p^,xp^);
mAng := 0; //#From Oleg# //14.09.2010
for i := 0 to xPaths.Count - 1 do
begin
path := TNetPath(xPaths[i]);
xp := path.OtherPoint(p);
angle := GetRadOfLine(p^,xp^);
angle := oAngle - Angle;
if angle < 0 then
angle := 2 * pi + Angle;
if i = 0 then
begin
mAng := Angle;
xPath:= path;
end
else
begin
if Angle < mAng then
begin
mAng := Angle;
xPath:= path;
end;
end;
end;
result := xPath;
xPaths.Free;
end;
function TNet.FindClockWPath(cPaths: TList; p: PDoublePoint;
oPath: TnetPath): TnetPath;
var
xp: pDoublePoint;
xPaths: TList;
i: Integer;
path,xPath: TnetPath;
angle: Double;
mAng: Double;
oAngle : Double;
begin
result := nil;
xPaths := TList.Create;
GetPathsOfKnot(p,cPaths,xpaths);
xPath := nil;
xp := opath.OtherPoint(p);
oAngle := GetRadOfLine(p^,xp^);
mAng := 0; //#From Oleg# //14.09.2010
for i := 0 to xPaths.Count - 1 do
begin
path := TNetPath(xPaths[i]);
xp := path.OtherPoint(p);
angle := GetRadOfLine(p^,xp^);
angle := oAngle - Angle;
if angle < 0 then
angle := 2 * pi + Angle;
if i = 0 then
begin
mAng := Angle;
xPath:= path;
end
else
begin
if Angle > mAng then
begin
mAng := Angle;
xPath:= path;
end;
end;
end;
result := xPath;
xPaths.Free;
end;
function TNet.FindIntersections(p1, p2: TDoublePoint;
var pArr: TDoublePointArr): Boolean;
var
i: Integer;
path: TnetPath;
cnt: Integer;
p: TdoublePOint;
inserted: TList;
begin
result := false;
cnt := 0;
SetLength(parr,0);
inserted:= TList.Create;
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(Paths[i]);
if (Path.WType = wtWall) then
begin
if GetIntersectionPoint(p1,p2,path.p1^,path.p2^,p,false) then
begin
cnt := cnt + 1;
SetLength(pArr,cnt);
pArr[cnt - 1] := p;
result := true;
end
else
begin
if (not EQDP(path.p1^,p1)) and (not EQDP(path.p1^,p2)) and isPointInLine(p1,p2,path.p1^,1) then
begin
if inserted.indexof(path.p1) = -1 then
begin
cnt := cnt +1;
SetLength(pArr,cnt);
pArr[cnt-1] := path.p1^;
result := true;
inserted.add(path.p1);
end;
end
else
if (not EQDP(path.p2^,p1)) and (not EQDP(path.p2^,p2)) and isPointInLine(p1,p2,path.p2^,1) then
begin
if inserted.indexof(path.p2) = -1 then
begin
cnt := cnt +1;
SetLength(pArr,cnt);
pArr[cnt-1] := path.p2^;
result := true;
inserted.add(path.p2);
end;
end;
end;
end;
end;
inserted.Free;
if result then begin
SortPointsOnLine(p1,p2,pArr);
end;
end;
function TNet.FindStartPath(cPaths:TList;p:PDoublePoint): TNetPath;
var
xp: pDoublePoint;
xPaths: TList;
i: Integer;
path,xPath: TnetPath;
angle: Double;
mAng: Double;
begin
Result := nil;
xPaths := TList.Create;
GetPathsOfKnot(p,cPaths,xpaths);
xPath := nil;
mAng := 0; //#From Oleg# //14.09.2010
for i := 0 to xPaths.Count - 1 do
begin
path := TNetPath(xPaths[i]);
xp := path.OtherPoint(p);
angle := GetRadOfLine(p^,xp^);
if angle = 0 then
angle := 2 * pi;
if angle >= pi then
angle := angle - pi
else
angle := pi + Angle;
if i = 0 then
begin
mAng := Angle;
xPath:= path;
end
else
begin
if Angle < mAng then
begin
mAng := Angle;
xPath:= path;
end;
end;
end;
result := xPath;
xPaths.Free;
end;
function TNet.FindStartPoint(xPaths:TList): PDoublePoint;
var
figMaxX, figMaxY, figMinX, figMinY: Double;
xp,p: PDoublePoint;
i: Integer;
dist,len: double;
lp: TDoublePoint;
xPoints: TList;
p1,p2: PDoublePoint;
begin
result := nil;
GetPathBounds(xPaths,figMaxX, figMaxY, figMinX, figMinY);
xPoints := TList.Create;
for i := 0 to xPaths.Count - 1 do
begin
p1 := TNetPath(Xpaths[i]).p1;
p2 := TNetPath(Xpaths[i]).p2;
if xPoints.IndexOf(p1) = -1 then
xPoints.Add(p1);
if xPoints.IndexOf(p2) = -1 then
xPoints.Add(p2);
end;
lp := DoublePoint(figMinX,figMinY);
dist := -1;
xp:= nil;
For i := 0 to xPoints.Count - 1 do
begin
p := PDoublePoint(xPoints[i]);
len := GetLineLenght(p^,lp);
if dist = -1 then
begin
dist := len;
xp := p;
end
else
begin
if len < dist then
begin
dist := len;
xp := p;
end;
end;
end;
xPoints.Free;
result := xp;
end;
procedure TNet.GetSelBounds(var figMaxX, figMaxY, figMinX, figMinY: Double);
var
i: Integer;
p: TDoublePoint;
index: Integer;
Path: TnetPath;
Struct: TnetStruct;
begin
if Points.Count = 0 then
exit;
if (SelType = stPath) and (SelIndex > 0) then
begin
index := SelIndex - 1;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
Path.GetBounds(figMaxX, figMaxY, figMinX, figMinY);
end;
end
else
if (SelType = stStruct) and (SelIndex > 0) then
begin
index := SelIndex - 1;
if index < Structs.Count then
begin
Struct := TNetStruct(Structs[Index]);
Struct.GetBounds(figMaxX, figMaxY, figMinX, figMinY);
end;
end
else
begin
p := PDoublePoint(Points[0])^;
figMaxX := p.x;
figMinX := p.x;
figMaxY := p.y;
figMinY := p.y;
For i := 1 to Points.Count - 1 do
begin
p := PDoublePoint(Points[i])^;
if p.x > figMaxX then
figMaxX := p.x;
if p.x < figMinX then
figMinX := p.x;
if p.y > figMaxY then
figMaxY := p.y;
if p.y < figMinY then
figMinY := p.y;
end;
end;
end;
procedure TNet.GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double);
var
i: Integer;
p: TDoublePoint;
begin
if Points.Count = 0 then
//Tolik 01/07/2019 -- ïåðåìåííûå èçíà÷àëüíî ïðèõîäÿò íåèíèöèàëèçèðîâàííûå, ïîýòîìó äëÿ îòðèñîâêè íóæíî ñáðîñèòü "ìóñîð" !!!
begin
figMaxX := 0;
figMaxY := 0;
figMinX := 0;
figMinY := 0;
//
exit;
end;
p := PDoublePoint(Points[0])^;
figMaxX := p.x;
figMinX := p.x;
figMaxY := p.y;
figMinY := p.y;
For i := 1 to Points.Count - 1 do
begin
p := PDoublePoint(Points[i])^;
if (abs(p.x) < 10000) and (abs(p.y) < 10000) then
begin
if p.x > figMaxX then
figMaxX := p.x;
if p.x < figMinX then
figMinX := p.x;
if p.y > figMaxY then
figMaxY := p.y;
if p.y < figMinY then
figMinY := p.y;
end;
end;
end;
procedure TNet.GetModPoints(ModList: TMyList);
var
i, j, index: Integer;
CControl: TPCdrawing;
x, y: Double;
SelPoint, p: PDoublePoint;
path, SelPath: TnetPath;
struct: TNetStruct;
stair: TFigure;
act: Boolean;
mp, cp: TDoublePoint;
modP: TmodPoint;
Door: TNetDoor;
begin
CControl := TPCDrawing(Owner);
path := nil;
struct := nil;
SelPoint := Self.SelPt;
if SelPoint <> nil then//23.08.2011 if (FSelPtIdx <> -1) and (FSelPtIdx < Points.Count) then
begin
//23.08.2011 p := Points[FSelPtIdx];
ModList.Add(CControl.RegisterModPoint(self, ptPolyPoint, ptCircle, clBlue, 2, SelPoint^.x, SelPoint^.y, FSelPtIdx));
end
else
begin
if (SelType = stPath) and (SelIndex > 0) then
begin
index := SelIndex - 1;
if index > Paths.Count - 1 then
SelIndex := 0;
if index < Paths.Count then
path := TnetPath(Paths[Index]);
end
else
if (SelType = stStruct) and (SelIndex > 0) then
begin
index := SelIndex - 1;
if index > Structs.Count - 1 then
SelIndex := 0;
if index < Structs.Count then
struct := TNetStruct(Structs[Index]);
end;
for i := 0 to Points.Count-1 do
begin
p := PDoublePoint(Points[i]);
act := True;
if assigned(path) then
begin
act := (path.isKnotIn(p) <> 0);
// Åñëè åñòü íåñêîëüêî âûäåëåííûõ ñåãìåíòîâ
if Not act then
for j := 0 to FSelection.Count - 1 do
begin
SelPath := TNetPath(FSelection[j]);
if (SelPath <> path) and (Paths.IndexOf(SelPath) <> -1) then
if (SelPath.isKnotIn(p) <> 0) then
begin
act := true;
Break; //// BREAK ////
end;
end;
end
else
if assigned(Struct) then
begin
act := (Struct.isKnotIn(p) <> -1);
end;
if act then
begin
ModList.Add(CControl.RegisterModPoint(self, ptPolyPoint, ptCircle, clBlue, 2, p.x, p.y, i));
end;
end;
if assigned(path) then
begin
if (Path.DoorIndex > -1) then
begin
//13.10.2010 i := (Paths.IndexOf(path));
//13.10.2010 mp := MPoint(path.p1^, path.p2^, 6.0);
//13.10.2010 ModList.Add(CControl.RegisterModPoint(self, ptGroupPoint, ptRect, clRed, 3, mp.x, mp.y, i));
//11.10.2010 Door Mod-points
Door := Path.ActiveDoor;
if Door <> nil then
begin
ModList.Add(CControl.RegisterModPoint(self, ptControlPoint, ptCircle, clGreen, 2, Door.p1.x, Door.p1.y, -3));
ModList.Add(CControl.RegisterModPoint(self, ptControlPoint, ptCircle, clGreen, 2, Door.p2.x, Door.p2.y, -3));
end;
end
else
begin
//13.10.2010 - ìîä.ïîèíò äëÿ ïåðåìåùåíèÿ ñåãìåíòà â ñòîðîíû
i := (Paths.IndexOf(path));
if path.GetLenByPoints(path.p1^, path.p2^) > 0 then
begin
mp := MPoint(path.p1^, path.p2^, 6.0);
// Tolik - 11/01/2022 - òóò ïðîåá...òàê êàê çäåñü i - óæå íå èíäåêñ òî÷êè â ñïèñêå, çà ñ÷åò ýòîãî
// "âûáüåò" ïðîèçâîëüíóþ òî÷êó èç ìîäïîèíòîâ, îïðåäåëÿåìûõ íèæå, êàê íåðåäàêòèðóåìûå(÷åðíûå)
//ModList.Add(CControl.RegisterModPoint(self, ptGroupPoint, ptRect, clRed, 3, mp.x, mp.y, i));
ModList.Add(CControl.RegisterModPoint(self, ptGroupPoint, ptRect, clRed, 3, mp.x, mp.y, -5));
//
//22.10.2010 - ìîä.ïîèíò äëÿ èçìåíåíèÿ ðàäèóñà
if path.IsArc then
begin
//Tolik --11/01/2022 -- òà æå õåðíÿ
//ModList.Add(CControl.RegisterModPoint(self, ptArcControl, ptRect, clGreen, 3, path.ArcCenter.x, path.ArcCenter.y, i));
ModList.Add(CControl.RegisterModPoint(self, ptArcControl, ptRect, clGreen, 3, path.ArcCenter.x, path.ArcCenter.y, -5));
//
end;
end;
end;
end;
end;
// Îñòàëüíûå òî÷êè ÷åðíûì öâåòîì è áåç âîçìîæíîñòè ìîäèôèêàöèè
for i := 0 to Points.Count - 1 do
begin
// Ïðîâåðÿåì åñòü ëè òàêîé èíäåêñ â ñïèñêå
p := nil;
for j := 0 to ModList.Count - 1 do
begin
modP := TmodPoint(ModList[j]);
if modP.SeqNbr = i then
begin
p := Points[i];
Break; //// BREAK ////
end;
end;
if p = nil then
begin
p := Points[i];
ModList.Add(CControl.RegisterModPoint(self, ptPolyPoint, ptCircle, clBlack, 1, p^.x, p^.y, -4));
end;
end;
end;
function TNet.GetNetPath(p1, p2: PDoublePoint): TnetPath;
var
i: Integer;
path: TnetPath;
begin
result := nil;
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(paths[i]);
if path.AreYou(p1,p2) then
begin
result:= path;
exit;
end;
end;
end;
procedure TNet.GetPathBounds(xPaths: Tlist; var figMaxX, figMaxY, figMinX,
figMinY: Double; aLengthType: TShowPathLengthType=sltPoints);
var
i: Integer;
p: TDoublePoint;
p1,p2: PDoublePoint;
xPoints: TList;
xPath: TNetPath;
begin
xPoints := TList.Create;
for i := 0 to xPaths.Count-1 do
begin
xPath := TNetPath(Xpaths[i]);
//28.04.2012 p1 := xPath.p1;
//28.04.2012 p2 := xPath.p2;
if aLengthType <> sltPoints then
xPath.DefineInOutPoints;
p1 := xPath.GetPointByLenghType(1, aLengthType);
p2 := xPath.GetPointByLenghType(2, aLengthType);
if xPoints.IndexOf(p1) = -1 then
xPoints.Add(p1);
if xPoints.IndexOf(p2) = -1 then
xPoints.Add(p2);
end;
if xPoints.Count = 0 then
begin
xPOints.Free;
exit;
end;
p := PDoublePoint(xPoints[0])^;
figMaxX := p.x;
figMinX := p.x;
figMaxY := p.y;
figMinY := p.y;
For i := 1 to xPoints.Count-1 do
begin
p := PDoublePoint(xPoints[i])^;
if p.x > figMaxX then
figMaxX := p.x;
if p.x < figMinX then
figMinX := p.x;
if p.y > figMaxY then
figMaxY := p.y;
if p.y < figMinY then
figMinY := p.y;
end;
xPoints.Free;
end;
procedure TNet.GetSize(aLengthType: TShowPathLengthType; var figHeight, figWidth: Double);
var
figMaxX, figMaxY, figMinX, figMinY: Double;
begin
//28.04.2012 GetBounds(figMaxX,figMaxY,figMinX,figMinY);
GetPathBounds(Paths, figMaxX,figMaxY,figMinX,figMinY);
figHeight := figMaxY - figMinY;
figWidth := figMaxX - figMinX;
end;
procedure TNet.GetPathsOfKnot(p: PDoublePoint; var xPaths: TList);
var
i: Integer;
begin
for i := 0 to Paths.Count - 1 do
begin
if TnetPath(Paths[i]).isKnotIn(p) > 0 then
begin
xPaths.Add(Paths[i]);
end;
end;
end;
procedure TNet.GetPathsOfKnot(p: PDoublePoint; lPaths: Tlist;
var xPaths: TList);
var
i: Integer;
begin
for i := 0 to lPaths.Count - 1 do
begin
if TnetPath(lPaths[i]).isKnotIn(p) > 0 then
begin
xPaths.Add(lPaths[i]);
end;
end;
end;
Function TNet.GroupPathPointsByIntersection(pArr: TDoublePointArr; var pGrp: TDoublePointGroup): Boolean;
var
p1, p2, p, p3, p4: TDoublePoint;
i, pCnt, cnt, k: Integer;
iArr: TDoublePointArr;
done: Boolean;
gCnt, iCnt: Integer;
path: TNetPath;
begin
result := true;
pCnt:= Length(pArr);
if Not FDisableMergePaths then //15.10.2010
if FAllowDelPathOnMake then //26.09.2011
begin
for i := 0 to pCnt - 2 do
begin
p1 := pArr[i];
p2 := pArr[i + 1];
for k := Paths.Count - 1 downto 0 do
begin
path := TnetPath(Paths[k]);
if (IsPointInLine(p1, p2, path.p1^, 1, 0) and IsPointInLine(p1, p2, path.p2^, 1, 0)) or
(IsPointInLine(path.p1^, path.p2^, p1, 1, 0) and IsPointInLine(path.p1^, path.p2^, p2, 1, 0)) then
begin
if (path.Broken) then
begin
DeletePath(path);
end
else
begin
result := false;
exit;
end;
end;
end;
end;
end;
//Äåëàåì èç ïîëèãîíà ïðàâèëüíûé,åñëè ó íåãî íåò ïîñëåäíåé òî÷êè
if (not EQDP(pArr[pCnt-1], pArr[0]))and(GCadForm.PCad.ToolInfo = 'TWallRect') then
begin
pCnt:= pCnt + 1;
SetLength(pArr,pCnt);
pArr[pCnt-1] := pArr[0];
end;
p1 := pArr[0];
p2 := pArr[1];
p3 := pArr[pCnt - 2];
p4 := pArr[pcnt - 1];
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(Paths[i]);
if path.IsPointIn(p1.x, p1.y) then
begin
path.PointToWall(p1, p2);
pArr[0] := p1;
end
else
if path.IsPointIn(p4.x, p4.y) then
begin
path.PointToWall(p4, p3);
pArr[pcnt-1] := p4;
end;
end;
gCnt := 1;
SetLength(pGrp,gCnt);
pCnt:= Length(pArr);
SetLength(pGrp[0], 0);
done := false;
// Add first point
i := 0;
cnt := 0;
cnt := cnt + 1;
SetLength(pGrp[gCnt - 1], cnt);
p1 := pArr[i];
pGrp[gcnt - 1][cnt - 1] := p1;
repeat
p1 := pArr[i];
p2 := pArr[i + 1];
if Not FDisableMergePaths and FindIntersections(p1, p2, iArr) then
begin
// Add Intersecting Points
iCnt := Length(iArr);
for k := 0 to icnt - 1 do
begin
cnt := cnt + 1;
SetLength(pGrp[gCnt - 1], cnt);
pGrp[gcnt - 1][cnt - 1] := iArr[k];
gCnt := gCnt + 1;
SetLength(pGrp, gCnt);
cnt := 0;
cnt := cnt + 1;
SetLength(pGrp[gCnt - 1], cnt);
pGrp[gcnt - 1][cnt - 1] := iArr[k];
end;
// Add LastPoint
cnt := cnt + 1;
SetLength(pGrp[gCnt - 1], cnt);
pGrp[gcnt - 1][cnt - 1] := p2;
end
else
begin
cnt := cnt + 1;
SetLength(pGrp[gCnt - 1], cnt);
pGrp[gcnt - 1][cnt - 1] := p2;
end;
i := i + 1;
if i >= pcnt - 1 then
done := true;
until done;
end;
procedure TNet.Initialize;
begin
inherited;
PointCount:= 0;
Paths := TList.Create;
Points := TList.Create;
Structs := TList.Create;
Modified := False;
LockMove := False;
EndDraw := True;
ContextMenu := True;
DrawGuides := True;
EditMode := False;
DrawAsTrace := False;
DetDraw := False;
FAllowDelPathOnMake := true; //26.09.2011
//FAllowCleanSamePointsInGrpPointArray := false; //21.06.2012
FAllowAddPathWithSamePoints := true; //21.06.2012
FDrawedPt1 := TList.Create; //13.05.2011
FDrawedPt2 := TList.Create; //13.05.2011
FPointIDs := TList.Create; //04.10.2010
FSelection := TList.Create; //27.07.2011
FSelectingPt := false;
FSelPtIdx := -1;
FAfterAllScale := AfterAllScale;
FBeforeAllScale := BeforeAllScale;
FScaleAllEvent := ScaleAllEvent;
FBeforeDelFromParent := BeforeDelFromParent;
FAfterUndo := AfterUndo;
FPathTracePoint := nil; //21.10.2010
FRelatedOwner := nil; //21.10.2010
FRelatedPoints := TList.Create;
FRelatedNets := TList.Create;
FRelatedObject := nil;
FRelatedMPoint := nil; //19.10.2010
FRelatedMPath := nil; //24.05.2011
FSrcNet := nil; //21.10.2010
FJoinedMovePoints := TList.Create; //23.05.2011
FJoinedMovePointsDirections := TList.Create;
FJoinedMovePointsFixedState := TList.Create; //27.05.2011
FJoinedMovePaths := TList.Create; //24.05.2011
FJoinedMovePathsDirections := TList.Create;
FSavedPoints := TList.Create;
FSavedScaledPoints := TList.Create;
if Not Assigned(Self.FOnDelete) then
GArchEngine.SetHandlersToObj(Self);
end;
function CheckPointForOtherNets(Point1: TDoublePoint): Boolean;
Var
CAD: TF_CAD;
Figure: TFigure;
i,j,PathsCount: Integer;
xNet: TNet;
xNetPath: TNetPath;
P1,P2: TDoublePoint;
begin
Result := False;
PathsCount := 0;
CAD := TF_CAD(GCadForm);
for i := 0 to CAD.PCad.Figures.Count - 1 do
begin
Figure := TFigure(CAD.PCad.Figures[i]);
if (Figure is TNet) and (TNet(Figure).FComponID <> 0) then
begin
xNet := Tnet(Figure);
for j := 0 to xNet.Paths.Count - 1 do
begin
xNetPath := TNetPath(xNet.Paths[j]);
p1 := xNetPath.p1^;
P2 := xNetPath.p2^;
if ((P1.x = Point1.x)and(P1.y = Point1.y))or((P2.x = Point1.x)and(P2.y = Point1.y))then
begin
Inc(PathsCount);
Break;
end;
end;
end;
end;
Result := PathsCount > 1;
end;
Function CheckNetByRoof(aNetPath: TNetPath): Boolean;
var
SCSCompon: TSCSComponent;
i: Integer;
begin
Result := False;
SCSCompon := nil;
SCSCompon := GetArchObjByCADObj(aNetPath);
if SCSCompon <> nil then
for i := 0 to SCSCompon.Properties.Count - 1 do
begin
if PProperty(SCSCompon.Properties[i]).SysName = 'ROOF_HIP_TYPE' then
begin
Result := True;
Break;
end;
end;
end;
// Tolik 17/10/2016--
// Function TNet.InsertKnot(p: TDoublePoint; force: Boolean = false; aPathOnKnot: Pointer=nil): PDoublePoint;
Function TNet.InsertKnot(p: TDoublePoint; force: Boolean = false; aPathOnKnot: Pointer=nil; aPrevPoint: PDoublePoint = nil): PDoublePoint;
//
var
i: Integer;
p1, p2: PDoublePoint;
path, nPt: TnetPath;
{//22.06.2012
Function CheckForPoints(pp: TDoublePoint): PDoublePoint;
var
xp: PDoublePoint;
k: Integer;
LastDist: Double;
CurrDist: Double;
begin
result := nil;
LastDist := -1;
for k := 0 to Points.Count - 1 do
begin
xp := PDoublePoint(Points[k]);
//if EQDP(xp^, pp) then
// begin
CurrDist := GetLineLenght(xp^, pp);
if CurrDist <= (WallThick / 2) then
begin
if (LastDist = -1) or (LastDist > CurrDist) then
begin
LastDist := CurrDist;
result := xp;
//exit;
end;
end;
end;
end;}
Function CheckDistance(pn: TDoublePoint): Boolean;
var
k: Integer;
px: TDoublePoint;
begin
result := true;
for k := 0 to Points.Count - 1 do
begin
px:= PDoublePOint(Points[k])^;
if GetLineLenght(pn, px) <= (WallThick / 2) then
begin
result := false;
exit;
end;
end;
end;
begin
result := nil;
if aPathOnKnot <> nil then //02.04.2013
TNetPath(aPathOnKnot^) := nil;
//22.06.2012 p1 := CheckForPoints(p);
// Tolik 17/10/2016--
p1 := Nil;
p1 := CheckForPoints(p, aPrevPoint);
if assigned(p1) then
begin
result := p1;
if aPathOnKnot <> nil then //02.04.2013
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(Paths[i]);
if path.isKnotIn(result) <> 0 then
begin
TNetPath(aPathOnKnot^) := path;
Break; //// BREAK ////
end;
end;
exit;
end;
if Not FDisableMergePaths then //#From Oleg#
begin
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(Paths[i]);
if (path.isPointOnLine(p.x, p.y)) then
begin
PointToLine(path.p1^, path.p2^, p.x, p.y);
p1 := CheckForPoints(p);
if not assigned(p1) then
begin
if CheckDistance(p) then
begin
//Åñëè ýòî íå êðûøà, òîãäà äåëàòü êàê ðàíüøå...
if not CheckNetByRoof(path.Opath) then
begin
p1 := AddPoint(p, path);
p2 := path.p2;
path.p2 := p1;
nPt := AddPath(p1, p2, path.border);
if Assigned(FOnAutoAddPath) then
FOnAutoAddPath(Self, path, nPt);
if nPt <> nil then
begin
nPt.wstyle := path.wstyle;
nPt.FColor := path.FColor;
nPt.FBrushColor := path.FBrushColor;
nPt.FBrushStyle := path.FBrushStyle;
if nPt.Width <> path.Width then
begin
nPt.Width := path.Width;
RefreshPaths;
end;
end;
end
else
p1 := AddPoint(p, path);
end
else
exit;
end;
result := p1;
//02.04.2013
if aPathOnKnot <> nil then
TNetPath(aPathOnKnot^) := path;
exit;
end;
end;
end;
if force then
begin
// Tolik 17/10/2016-- åñëè ïîòðåáóåòñÿ âîçìîæíîñòü ðàññòàíîâêè òî÷åê áëèæå äðóã ê äðóæêå, ÷åì òîëùèíà ñòåíû --
// òîãäà ðàñêîììåíòèòü òî, ÷òî çàêîììåí÷åíî íèæå
// if aPrevPoint = nil then
begin
//
if CheckDistance(p) then
begin
p1 := AddPoint(p);
result := p1;
end;
end;
// Tolik 17/10/2016--
// else
// result := AddPoint(p);
end;
end;
// Tolik -- 19/10/2016 -- ïîïûòàòüñÿ âûðîâíÿòü
Procedure TNet.CorrectNetPathPosbyRelatedPath(aPath: TNetPath; dx,dy: double);
var currNet, RelatedNet: TNet;
RelatedPathList: TList;
RelatedPath: TNetPath;
deltax, deltay: double;
aPathLength, RelatedPathLength: double;
i: Integer;
OrthoPoint: PDoublePoint;
// âåðíåò îðòîãîíàëüíóþ òî÷êó, íî òîëüêî â òîì ñëó÷àå, åñëè îíà åñòü è åå ìîæíî äâèíóòü
// ò.å. ó íåå íåò ïðèêîííåê÷åííûõ òî÷åê
function GetOrthogonalPoint(aPoint: PDoublePoint): PDoublePoint;
var i: Integer;
currPathList: TList;
currPath: TNetPath;
currPoint: PDoublePoint;
isOrthogonal: Boolean;
RelatedPointsList: TList;
begin
Result := Nil;
// ïîëó÷èòü ñìåæíûå ïóòè â òî÷êå
currPathList := GetPathListByPoint(aPoint);
if ((currPathList <> nil) and (currPathList.Count > 0)) then
begin
currPath := nil;
for i := 0 to currPathList.Count - 1 do
begin
if TNetPath(currPathList) <> aPath then
begin
currPath := TNetPath(currPathList[i]);
break;
end;
end;
FreeAndNil(currPathList);
// ïðîòèâîïîëîæíàÿ òî÷êà ñìåæíîãî ïóòè
if currPath <> nil then
begin
currPoint := nil;
if currPath.p1 <> APoint then
currPoint := currPath.p1
else
if currPath.p2 <> aPoint then
currPoint := currPath.p2;
end;
if currPoint <> nil then
begin
if ((CompareValue(aPoint.x, currPoint.x) = 0) or (CompareValue(aPoint.y, currPoint.y) = 0)) then
begin
// ïîëó÷èòü ñïèñîê ïðèñîåäèíåííûõ òî÷åê
RelatedPointsList := GetRelatedPoints(currPoint);
// åñëè ïðèñîåäèíåííûõ òî÷åê íåò - âîçâðàùàåì ðåçóòüòàò
if ((RelatedPointsList = nil) or ((RelatedPointsList <> nil) and (RelatedPointsList.Count = 0))) then
Result := currPoint;
if RelatedPointsList <> nil then
FreeAndNil(RelatedPointsList);
end;
end;
end;
end;
begin
if aPath <> nil then
begin
//if Self.IsRectangle and (self.Paths.Count = 4) then
// ëó÷øå òàê èáî áûâàåò ïîäâèñàåò IsRectangle äà è áûñòðåå ïðîâåðèòü self.Paths.Count
// ñì. çàäà÷ó: https://app.asana.com/0/388690353475548/876171867625289
// ïðè òàêîé êîíôèãóðàöèè ñòåí (âàæíî ãäå êàêîé íîä ðàñïîëîæåí) - https://prnt.sc/l90su0
if (self.Paths.Count = 4) and Self.IsRectangle then
begin
RelatedNet := nil;
RelatedPathList := GetRelatedPaths(aPath);
if RelatedPathList <> nil then
begin
RelatedPath := TNetPath(RelatedPathList[0]);
deltax := 0;
deltay := 0;
// ïåðâàÿ òî÷êà
if pointNear(aPath.p1^, RelatedPath.p1^,3) then
begin
deltax := RelatedPath.p1.x - aPath.p1.x;
deltay := RelatedPath.p1.y - aPath.p1.y;
end
else
if pointNear(aPath.p1^, RelatedPath.p2^, 3) then
begin
deltax := RelatedPath.p2.x - aPath.p1.x;
deltay := RelatedPath.p2.y - aPath.p1.y;
end;
if (deltax <> 0) or (deltay <> 0) then // åñëè íóæíî ïðèòÿíóòü òî÷êó ê ñîñåäíåé
begin
OrthoPoint := Nil;
aPath.p1.x := aPath.p1.x + deltax;
aPath.p1.y := aPath.p1.y + deltay;
// ïîëó÷èòü îðòîãîíàëüíóþ òî÷êó
OrthoPoint := GetOrthogonalPoint(aPath.p1);
if OrthoPoint <> nil then
begin
OrthoPoint.x := OrthoPoint.x + deltax;
OrthoPoint.y := OrthoPoint.y + deltay;
end;
end;
deltax := 0;
deltay := 0;
OrthoPoint := Nil;
// âòîðàÿ òî÷êà
if pointNear(aPath.p2^, RelatedPath.p1^,3) then
begin
deltax := RelatedPath.p1.x - aPath.p2.x;
deltay := RelatedPath.p1.y - aPath.p2.y;
end
else
if pointNear(aPath.p2^, RelatedPath.p2^, 3) then
begin
deltax := RelatedPath.p2.x - aPath.p2.x;
deltay := RelatedPath.p2.y - aPath.p2.y;
end;
if (deltax <> 0) or (deltay <> 0) then
begin
aPath.p2.x := aPath.p2.x + deltax;
aPath.p2.y := aPath.p2.y + deltay;
// ïîëó÷èòü îðòîãîíàëüíóþ òî÷êó
OrthoPoint := GetOrthogonalPoint(aPath.p2);
if OrthoPoint <> nil then
begin
OrthoPoint.x := OrthoPoint.x + deltax;
OrthoPoint.y := OrthoPoint.y + deltay;
end;
end;
Self.RefreshPoints;
Self.SetModified;
{Self.FMoveAllPoints := True;
Self.Move(deltax, deltay);
Self.FMoveAllPoints := False;}
{
if deltax <> 0 then
begin
for i := 0 to Points.Count - 1 do
begin
PDoublePoint(Points[i])^.x := PDoublePoint(Points[i])^.x + deltax;
end;
end;
if deltay <> 0 then
begin
for i := 0 to Points.Count - 1 do
begin
PDoublePoint(Points[i])^.y := PDoublePoint(Points[i])^.y + deltay;
end;
end; }
GCadForm.PCad.Refresh;
end;
end;
end;
end;
Function TNet.GetSCSRoomConture(aNet: TNet):TDoublePointArr; // Tolik 22/06/2018 --
var currPath: TNetPath;
PasedList, PathList: TList;
i:Integer;
ResultList: TList;
isPathConture: Boolean;
FullPathConture: TDoublePointArr;
begin
SetLength(Result, 0);
ResultList := TList.Create;
if aNet.Paths.Count > 2 then
begin
for i := 0 to aNet.Paths.Count - 1 do
begin
currPath := TNetPath(aNet.Paths[i]);
Result := currPath.GetFullConture;
end;
{SetLength(Result, ResultList.Count);
for i := 0 to ResultList.count - 1 do
begin
Result[i].x := PDoublePoint(ResultList[i]).x;
Result[i].y := PDoublePoint(ResultList[i]).y;
Result[i].z := 0;
end;
ResultList.free;}
end;
end;
class function TNet.InsideSelection: Boolean;
begin
result := True;
end;
procedure TNet.IntersectCorner(pIndex:Integer);
var
path: TnetPath;
p1,p2: TDoublePoint;
p3,p4: TDoublePoint;
xPaths: TList;
p: PDoublePoint;
id,i,k,cnt,icnt: Integer;
path1,path2: TnetPath;
ip,ip1,ip2: TDoublePOint;
intersect: Boolean;
closed: Boolean;
lPath: TnetPath;
r1,r2,radius: Double;
HasWall: Boolean;
HasGlass: Boolean;
j1,j2: TDoublePOint;
//pl1, pl2, pl3, pl4: Double;
PathsAngleRad: Double;
FindedPt: Boolean;
MovedPt: Boolean; //17.05.2012
MovedPtSide: Integer;
MovedPtPathSide: Char; // l or r
MovePtDeltaX, MovePtDeltaY: Double; //17.05.2012
MovePtStaticPath: TNetPath;
MovePtPath: TNetPath;
MovePtIntersect, MoveSPtIntersect: PDoublePoint; //17.05.2012
MovePtInverseIntersect, MoveSPtInverseIntersect: PDoublePoint; //17.05.2012
MoveParallelEPt: PDoublePoint;
ptrMovePerpendicularEPt: Pointer;
StaticParallelEPt: PDoublePoint;
PointList, OtherPointList: TList;
ptrTempPt, ptrTempPt2: PDoublePoint;
MoveOtherPath: TNetPath;
ap, bp: TDoublePoint;
OtherIp: PDoublePoint;
j, l: Integer;
TempPt1, TempPt2: TDoublePoint;
TempLinePt1, TempLinePt2: TDoublePoint;
arcPoints: TList;
arcLPoints: TList;
procedure CorrectCoord(var aCoord, aSecondCoord: Double);
begin
if Abs(aCoord - aSecondCoord) < 0.2 then
aSecondCoord := aCoord;
end;
procedure CorrectPtCoord(var aPt, aSecondPt: TDoublePoint);
begin
CorrectCoord(aPt.x, aSecondPt.x);
CorrectCoord(aPt.y, aSecondPt.y);
CorrectCoord(aPt.x, aSecondPt.y);
//aPt.x := RoundX(aPt.x, 2);
//aPt.y := RoundX(aPt.y, 2);
end;
//17.05.2012
procedure ApplyIntersectPt(aPath: TNetPath; aPtSide: Integer; aPathSide: Char; aDestPt, aSecondDestPt,
aParallelEPt,
aInversePt, aInverseSPt: PDoublePoint; aPerpendicularPt: Pointer);
var
ptCmp: TDoublePoint;
begin
if MovedPt then
begin
if MovePtPath = aPath then
begin
// Åñëè íå ñîâïàäàþò êîîðäèíàòû, òî çàïîìèíàåì ñåãìåíò è åãî òî÷êó, êîòîðàÿ áóäåò ïîäòÿíóòà ê òî÷êå ñâÿçàííîãî ñåãìåíòà
ptCmp := aDestPt^;
ptCmp.x := ptCmp.x - aPath.FPerpendDX;
ptCmp.y := ptCmp.y - aPath.FPerpendDY;
if Not EQDP(ptCmp, ip) then
begin
MovePtDeltaX := ip.x - aDestPt^.x;
MovePtDeltaY := ip.y - aDestPt^.y;
MovedPtSide := aPtSide;
MovedPtPathSide := aPathSide;
MovePtIntersect := aDestPt;
MoveSPtIntersect := aSecondDestPt;
MoveParallelEPt := aParallelEPt;
ptrMovePerpendicularEPt := aPerpendicularPt;
MovePtInverseIntersect := aInversePt;
MoveSPtInverseIntersect := aInverseSPt;
//MovePtPath := aPath;
end;
end
else if MovePtStaticPath = aPath then
begin
// Åñëè ñîâïàäàþò êîîðäèíàòû, òî çàïîìèíàåì ññûëêó íà òî÷êó ñåãìåíòà, ê êîòîðîé áóäåò ïîäâåäåíà òî÷êà äðóãîãî ñåãìåíòà
if EQDP(aDestPt^, ip) then
begin
StaticParallelEPt := aParallelEPt;
end;
end;
end;
if Not MovedPt then
begin
aDestPt^ := ip;
aSecondDestPt^ := aDestPt^;
end;
end;
begin
p := pDoublePoint(points[pIndex]);
xPaths := TList.Create;
cnt := 0;
HasWall:= False;
HasGlass := False;
lpath := nil; //#From Oleg# //14.09.2010
MovePtIntersect := nil;
arcPoints := TList.Create;
arcLPoints := TList.Create;
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(Paths[i]);
closed:= path.Isclosed;
id := path.isKnotValIn(p^);
if (id > 0) and (not Closed) then
begin
if path.WType in [wtWall,wtOpen,wtGlass,wtHalf] then
begin
if Path.WType in [wtWall,wtOpen] then
hasWall := True
else
HasGlass := True;
cnt := cnt + 1;
//15.08.2011 xPaths.Add(path);
if id = 1 then
path.Angle := GetRadOfLine(p^,path.p2^)
else
path.Angle := GetRadOfLine(p^,path.p1^);
path.Dir := id;
lPath := path;
if Path.WStyle = wsLine then //15.08.2011
begin
Path.a1 := Path.p1^;
Path.b1 := Path.p1^;
Path.l1 := Path.p1^;
Path.el1 := Path.p1^;
Path.r1 := Path.p1^;
Path.er1 := Path.p1^;
Path.a2 := Path.p2^;
Path.b2 := Path.p2^;
Path.l2 := Path.p2^;
Path.el2 := Path.p2^;
Path.r2 := Path.p2^;
Path.er2 := Path.p2^;
end
else
xPaths.Add(path);
end;
end;
end;
cnt := xPaths.Count;
if haswall and hasGlass then
begin
for i := cnt - 1 downto 0 do
begin
Path := TnetPath(xPaths[i]);
if Path.WType in [wtGlass,wtHalf] then
xPaths.Remove(Path);
end;
end;
cnt := xPaths.Count;
if cnt = 1 then
begin
if (lpath.dir = 1) then
begin
lpath.Empty1 := true;
if not lPath.isArc then
begin
lPath.a1 := MPoint(lPath.a1,lPath.a2, -lpath.Width/2);
lPath.b1 := MPoint(lPath.b1,lPath.b2, -lpath.Width/2);
lPath.l1 := MPoint(lPath.l1,lPath.l2, -lpath.Width/2);
lPath.el1 := lPath.l1;
lPath.r1 := MPoint(lPath.r1,lPath.r2, -lpath.Width/2);
lPath.er1 := lPath.r1;
end;
end
else
begin
lpath.Empty2 := true;
if not lPath.isArc then
begin
lPath.a2 := MPoint(lPath.a2,lPath.a1, -lpath.Width/2);
lPath.b2 := MPoint(lPath.b2,lPath.b1, -lpath.Width/2);
lPath.l2 := MPoint(lPath.l2,lPath.l1, -lpath.Width/2);
lPath.el2 := lPath.l2;
lPath.r2 := MPoint(lPath.r2,lPath.r1, -lpath.Width/2);
lPath.er2 := lPath.r2;
end;
end;
end;
// Tolik 21/07/2018 --
if xPaths.Count < 2 then
// Tolik -- 07/02/2017 --
// exit;
begin
FreeAndNil(xPaths);
arcPoints.free;
arcLPoints.free;
exit;
end;
//
SortPathAngles(xPaths,0,xPaths.Count - 1);
for i := 0 to xPaths.Count - 1 do
begin
path1 := TNetPath(xPaths[i]);
if i < xPaths.Count - 1 then
k := i + 1
else
k := 0;
path2 := TNetPath(xPaths[k]);
intersect := true;
if Intersect then
begin
///
if (not path1.isArc) and (not path2.isArc) then
begin
if path1.Dir = 1 then
begin
//CorrectPtCoord(path1.r1, path1.r2); //12.04.2012
p1 := path1.r1;
p2 := path1.r2;
end
else
begin
//CorrectPtCoord(path1.l1, path1.l2); //12.04.2012
p1 := path1.l1;
p2 := path1.l2;
end;
if path2.Dir = 2 then
begin
//CorrectPtCoord(path2.l1, path2.l2); //12.04.2012
p3 := path2.r1;
p4 := path2.r2;
end
else
begin
//CorrectPtCoord(path2.l1, path2.l2); //12.04.2012
p3 := path2.l1;
p4 := path2.l2;
end;
//12.04.2012 - åñëè X èëè Y òî÷êè î÷÷÷åíü ðÿäîì, òî ïîäòÿãèâàåì ê îäíîé? ÷òîáû íåáûëî äëèííûõ "ôàíåð"
{CorrectPtCoord(p1, p2);
CorrectPtCoord(p1, p3);
CorrectPtCoord(p1, p4);
CorrectPtCoord(p2, p3);
CorrectPtCoord(p2, p4);
CorrectPtCoord(p3, p4);}
PathsAngleRad := CorrectAngle(RadToDeg(GetRadOfLine(p1, p2) - GetRadOfLine(p3, p4)), 180);
//if PathsAngleRad > 180 then
// PathsAngleRad := PathsAngleRad - 180
//else if PathsAngleRad < 180 then
FindedPt := false;
MovedPt := false;
// Åñëè óãîë áîëåå ìåíåå åñòü, òî íàõîäèì òî÷êó â îáû÷íîì ðåæèìå
if {(PathsAngleRad = 0) or} ((PathsAngleRad >= 5) and (Abs(PathsAngleRad - 180) >= 5)) then // 3
//if true then //
begin
// ???
if GetIntersectionPoint(p1, p2, p3, p4, ip) then
begin
FindedPt := true;
end;
// ???
end
else
begin
//EmptyProcedure;
GetLinesNearPoints(@p1, @p2, @p3, @p4, ap, bp);
FindedPt := true;
//MovedPt := true;
MovePtDeltaX := 0;
MovePtDeltaY := 0;
MovePtPath := nil;
MovePtStaticPath := nil;
{if Path1.Width < Path2.Width then
begin
MovePtPath := Path1;
MovePtStaticPath := Path2;
end
else if Path1.Width > Path2.Width then
begin
MovePtPath := Path2;
MovePtStaticPath := Path1;
end;}
case CompareValue(Path1.Width, Path2.Width) of
LessThanValue:
begin
MovePtPath := Path1;
MovePtStaticPath := Path2;
end;
GreaterThanValue:
begin
MovePtPath := Path2;
MovePtStaticPath := Path1;
end;
EqualsValue:
begin
// Ïåðåìåùàòü ãðàíü áóäåì, êîòîðàÿ íå âåðòèêàëüíà è íå ãîðèçîíòàëüíà
if Not EQD(Path1.r1.x,Path1.r2.x) and Not EQD(Path1.r1.y, Path1.r2.y) then
begin
MovePtPath := Path1;
MovePtStaticPath := Path2;
end
else if Not EQD(Path2.r1.x, Path2.r2.x) and Not EQD(Path2.r1.y, Path2.r2.y) then
begin
MovePtPath := Path2;
MovePtStaticPath := Path1;
end;
if MovePtPath = nil then
if Path1.GetLenByPoints(Path1.p1^,Path1.p2^) < Path2.GetLenByPoints(Path2.p1^,Path2.p2^) then
begin
MovePtPath := Path1;
MovePtStaticPath := Path2;
end
else
begin
MovePtPath := Path2;
MovePtStaticPath := Path1;
end;
end;
end;
MovedPt := MovePtPath <> nil;
ip := ap;
//ip := bp;
if MovePtPath <> nil then
begin
if MovePtPath.FPerpendSide = 1 then
begin
if MovePtPath.Dir = 1 then
ip := bp;
end
else if MovePtPath.Dir <> 1 then
ip := bp;
end;
MovedPtSide := 0;
MovedPtPathSide := #0;
MovePtIntersect := nil;
MoveSPtIntersect := nil;
MovePtInverseIntersect := nil;
MoveSPtInverseIntersect := nil;
MoveParallelEPt := nil;
StaticParallelEPt := nil;
ptrMovePerpendicularEPt := nil;
end;
if FindedPt then
begin
{//17.05.2012
if path1.Dir = 1 then
begin
path1.r1 := ip;
path1.er1 := path1.r1;
end
else
begin
path1.l2 := ip;
path1.el2 := path1.l2;
end;
if path2.Dir = 1 then
begin
path2.l1 := ip;
path2.el1 := path2.l1;
end
else
begin
path2.r2 := ip;
path2.er2 := path2.r2;
end; }
//17.05.2012 Ïðèìåíåíèå òî÷êè ïåðåñå÷åíèÿ îáîèì Path
if path1.Dir = 1 then
ApplyIntersectPt(path1, 1, 'r', @path1.r1,@path1.er1, @path1.el1, @path1.r2,@path1.er2, @path1.epl1)
else
ApplyIntersectPt(path1, 2, 'l', @path1.l2,@path1.el2, @path1.er2, @path1.l1,@path1.el1, @path1.epr2);
if path2.Dir = 1 then
ApplyIntersectPt(path2, 1, 'l', @path2.l1,@path2.el1, @path2.er1, @path2.l2,@path2.el2, @path2.epr1)
else
ApplyIntersectPt(path2, 2, 'r', @path2.r2,@path2.er2, @path2.el2, @path2.r1,@path2.er1, @path2.epl2);
// Åñëè áûëà ïîäòÿíóòà òî÷êà, òî îñòàëüíûé ïîäòÿãèâàåì òîæ, ÷òîáû íåáûëî òðàïåöèé íå ñåãìåíòå
if MovedPt then
if MovePtIntersect <> nil then
begin
//ptrTempPt := MovePtPath.GetConnectedPoint(MovePtStaticPath);
//if GetPathCountByPoint(ptrTempPt) < 3 then
begin
//TempPt := MovePtInverseIntersect;
// TempPt^.x := TempPt^.x + MovePtDeltaX;
// TempPt^.y := TempPt^.y + MovePtDeltaY;
// TempPt := MoveSPtInverseIntersect;
// TempPt^.x := TempPt^.x + MovePtDeltaX;
// TempPt^.y := TempPt^.y + MovePtDeltaY;
//PointList := TList.Create;
//PointList.Add(@MovePtPath.r1);
//PointList.Add(@MovePtPath.er1);
//PointList.Add(@MovePtPath.r2);
//PointList.Add(@MovePtPath.er2);
//PointList.Add(@MovePtPath.l1);
//PointList.Add(@MovePtPath.el1);
//PointList.Add(@MovePtPath.l2);
//PointList.Add(@MovePtPath.el2);
// Äëÿ òî÷êè ïåðïåíäèêóëÿðà îò ïàðàëåëüíîé òî÷êè îò ïåðåìåùàåìîé, çàïîìèíàåì ññûëêó íà òî÷êó ñâÿçÿííîãî ñåãìåíòà, êîòîðûé òîëùå
if ptrMovePerpendicularEPt <> nil then
begin
ptrTempPt := MovePtPath.GetConnectedPoint(MovePtStaticPath);
if GetPathCountByPoint(ptrTempPt) < 3 then
PDoublePoint(ptrMovePerpendicularEPt^) := StaticParallelEPt
else
EmptyProcedure;
//if FPerpendPoints <> nil then
// FPerpendPoints.Add(StaticParallelEPt);
end;
//if MovePtPath.GetPointBySide(MovedPtSide) <> nil then
//if pIndex < 0 then
begin
PointList := MovePtPath.GetConturePoints(false, 0); // , MovedPtSide, MovedPtPathSide
for k := 0 to PointList.Count - 1 do
begin
ptrTempPt := PDoublePoint(PointList[k]);
for j := 0 to Paths.Count - 1 do
begin
MoveOtherPath := TNetpath(Paths[j]);
if (MoveOtherPath <> Path1) and (MoveOtherPath <> Path2) {and (MoveOtherPath.GetConnectedPoint(MovePtPath) <> nil)} then
//if EQDP(MoveOtherPath.GetConnectedPoint(MovePtPath)^, MovePtPath.GetPointBySide(MovedPtSide)^) then
//if MoveOtherPath.FComponId <> 163 then
begin
OtherPointList := MoveOtherPath.GetConturePoints(false);
//OtherPointList := MoveOtherPath.GetConturePoints(false, MoveOtherPath.GetConnectedSide(MovePtPath));
for l := 0 to OtherPointList.Count - 1 do
begin
ptrTempPt2 := PDoublePoint(OtherPointList[l]);
// Åñëè ýòà òî÷êà óæå ðàíåå îïðåäåëåíà êàê ïåðïåíäèêóëÿðíàÿ. òî ïðîïóñêàåì
//if FPerpendPoints <> nil then
// if FPerpendPoints.IndexOf(ptrTempPt2) <> -1 then
// Continue; //// CONTINUE ////
if EQDP(ptrTempPt^, ptrTempPt2^) then
begin
ptrTempPt2^.x := ptrTempPt2^.x + MovePtDeltaX;
ptrTempPt2^.y := ptrTempPt2^.y + MovePtDeltaY;
end;
end;
MoveOtherPath.SetEPoints;
FreeAndNil(OtherPointList);
if MoveOtherPath.isArc and MoveOtherPath.Connected(MovePtPath) then
begin
MoveOtherPath.FillArcJoinPoints(arcPoints, arcLPoints);
for l := 0 to arcPoints.Count - 1 do
begin
ptrTempPt2 := arcPoints[l];
if EQDP(ptrTempPt^, ptrTempPt2^) then
begin
ptrTempPt2^.x := ptrTempPt2^.x + MovePtDeltaX;
ptrTempPt2^.y := ptrTempPt2^.y + MovePtDeltaY;
end;
ptrTempPt2 := arcLPoints[l];
if EQDP(ptrTempPt^, ptrTempPt2^) then
begin
ptrTempPt2^.x := ptrTempPt2^.x + MovePtDeltaX;
ptrTempPt2^.y := ptrTempPt2^.y + MovePtDeltaY;
end;
end;
end;
end;
end;
//if (ptrTempPt <> MovePtIntersect) and (ptrTempPt <> MoveSPtIntersect) then
begin
ptrTempPt^.x := ptrTempPt^.x + MovePtDeltaX;
ptrTempPt^.y := ptrTempPt^.y + MovePtDeltaY;
end;
end;
FreeAndNil(PointList);
MovePtPath.SetEPoints;
end;
MovePt(@MovePtPath.a1, MovePtDeltaX, MovePtDeltaY);
MovePt(@MovePtPath.a2, MovePtDeltaX, MovePtDeltaY);
MovePt(@MovePtPath.b1, MovePtDeltaX, MovePtDeltaY);
MovePt(@MovePtPath.b2, MovePtDeltaX, MovePtDeltaY);
{if MovedPtSide = 1 then
begin
MovePtPath.FPerpend1DX := MovePtDeltaX;
MovePtPath.FPerpend1DY := MovePtDeltaY;
end
else if MovedPtSide = 2 then
begin
MovePtPath.FPerpend2DX := MovePtDeltaX;
MovePtPath.FPerpend2DY := MovePtDeltaY;
end;}
MovePtPath.FPerpendDX := MovePtPath.FPerpendDX + MovePtDeltaX;
MovePtPath.FPerpendDY := MovePtPath.FPerpendDY + MovePtDeltaY;
// Ïîäòÿãèâàåì òî÷êè åëåìåíòîâ ñåãìåíòà - äâåðè, îêíà è ò.ä.
if MovePtPath.Doors.Count > 0 then
begin
{TempPt1 := MovePtPath.p1^;
TempPt2 := MovePtPath.p2^;
//TempPt1.x := TempPt1.x + MovePtDeltaX;
//TempPt1.y := TempPt1.y + MovePtDeltaY;
//TempPt2.x := TempPt2.x + MovePtDeltaX;
//TempPt2.y := TempPt2.y + MovePtDeltaY;
TempPt1.x := TempPt1.x + MovePtPath.FPerpendDX;
TempPt1.y := TempPt1.y + MovePtPath.FPerpendDY;
TempPt2.x := TempPt2.x + MovePtPath.FPerpendDX;
TempPt2.y := TempPt2.y + MovePtPath.FPerpendDY;}
TempPt1 := MovePtPath.p1^;
TempPt2 := MovePtPath.p2^;
TempLinePt1 := MPoint(MovePtPath.el1, MovePtPath.er1);
TempLinePt2 := MPoint(MovePtPath.el2, MovePtPath.er2);
PointToLineByAngle(TempLinePt1, TempLinePt2, TempPt1);
PointToLineByAngle(TempLinePt1, TempLinePt2, TempPt2);
MovePtPath.CalculateDoorPoints(@TempPt1, @TempPt2);
////MovePtPath.CalculateDoorPoints(MovePtPath.p1, MovePtPath.p2);
end;
end;
end;
end;
///
end
else
if (path1.isArc) and (not path2.isArc) then
begin
if path1.Dir = 1 then
begin
p1 := path1.r2;
p2 := path1.r1;
end
else
begin
p1 := path1.l1;
p2 := path1.l2;
end;
if path2.Dir = 2 then
begin
p3 := path2.r1;
p4 := path2.r2;
end
else
begin
p3 := path2.l2;
p4 := path2.l1;
end;
radius := GetLineLenght(p1,path1.ArcCenter);
if GetLineCircleIntersection(p3,p4,path1.ArcCenter,radius,ip1,ip2,iCnt) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(p4, ip1, ip2);
if path1.Dir = 1 then
begin
path1.r1 := ip;
path1.er1 := path1.r1;
path1.ArcJoinB1 := ip;
path1.ArcJoinB1L := ip;
end
else
begin
path1.l2 := ip;
path1.el2 := path1.l2;
path1.ArcJoinA2 := ip;
path1.ArcJoinA2L := ip;
end;
if path2.Dir = 1 then
begin
path2.l1 := ip;
path2.el1 := path2.l1;
end
else
begin
path2.r2 := ip;
path2.er2 := path2.r2;
end;
end
else
begin
if (path1.Dir = 1) then
j1 := path1.r1
else
j1 := path1.l2;
if path2.Dir = 1 then
j2 := path2.l1
else
j2 := path2.r2;
if path1.Dir = 1 then
begin
path1.ArcJoinB1 := j1;
path1.ArcJoinB1L := j2;
end
else
begin
path1.ArcJoinA2 := j1;
path1.ArcJoinA2L := j2;
end;
end;
end
else
if (not path1.isArc) and (path2.isArc) then
begin
if path1.Dir = 1 then
begin
p1 := path1.r2;
p2 := path1.r1;
end
else
begin
p1 := path1.l1;
p2 := path1.l2;
end;
if path2.Dir = 2 then
begin
p3 := path2.r1;
p4 := path2.r2;
end
else
begin
p3 := path2.l2;
p4 := path2.l1;
end;
radius := GetLineLenght(p3,path2.ArcCenter);
if GetLineCircleIntersection(p1,p2,path2.ArcCenter,radius,ip1,ip2,iCnt) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(p2,ip1,ip2);
if path1.Dir = 1 then
begin
path1.r1 := ip;
path1.er1 := path1.r1;
end
else
begin
path1.l2 := ip;
path1.el2 := path1.l2;
end;
if path2.Dir = 1 then
begin
path2.l1 := ip;
path2.el1 := path2.l1;
path2.ArcJoinA1 := ip;
path2.ArcJoinA1L := ip;
end
else
begin
path2.r2 := ip;
path2.er2 := path2.r2;
path2.ArcJoinB2 := ip;
path2.ArcJoinB2L := ip;
end;
end
else
begin
if path1.Dir = 1 then
j1 := path1.r1
else
j1 := path1.l2;
if (path2.Dir = 1) then
j2 := path2.l1
else
j2 := path2.r2;
if path2.Dir = 1 then
begin
path2.ArcJoinA1 := j1;
path2.ArcJoinA1L := j2;
end
else
begin
path2.ArcJoinB2 := j1;
path2.ArcJoinB2L := j2;
end;
end;
end
else
if ( path1.isArc) and (path2.isArc) then
begin
if path1.Dir = 1 then
begin
p1 := path1.r2;
p2 := path1.r1;
end
else
begin
p1 := path1.l1;
p2 := path1.l2;
end;
if path2.Dir = 2 then
begin
p3 := path2.r1;
p4 := path2.r2;
end
else
begin
p3 := path2.l2;
p4 := path2.l1;
end;
r1 := GetLineLenght(p1,path1.ArcCenter);
r2 := GetLineLenght(p3,path2.ArcCenter);
if GetCircleCircleIntersection(path1.ArcCenter,r1,path2.ArcCenter,r2,ip1,ip2,iCnt) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(p2,ip1,ip2);
if path1.Dir = 1 then
begin
path1.r1 := ip;
path1.er1 := path1.r1;
path1.ArcJoinB1 := ip;
path1.ArcJoinB1L := ip;
end
else
begin
path1.l2 := ip;
path1.el2 := path1.l2;
path1.ArcJoinA2 := ip;
path1.ArcJoinA2L := ip;
end;
if path2.Dir = 1 then
begin
path2.l1 := ip;
path2.el1 := path2.l1;
path2.ArcJoinA1 := ip;
path2.ArcJoinA1L := ip;
end
else
begin
path2.r2 := ip;
path2.er2 := path2.r2;
path2.ArcJoinB2 := ip;
path2.ArcJoinB2L := ip;
end;
end
else
begin
if path1.Dir = 1 then
j1 := path1.r1
else
j1 := path1.l2;
if (path2.Dir = 1) then
j2 := path2.l1
else
j2 := path2.r2;
if path1.Dir = 1 then
begin
path1.ArcJoinB1 := j1;
path1.ArcJoinB1L := j2;
end
else
begin
path1.ArcJoinA2 := j1;
path1.ArcJoinA2L := j2;
end;
if path2.Dir = 1 then
begin
path2.ArcJoinA1 := j1;
path2.ArcJoinA1L := j2;
end
else
begin
path2.ArcJoinB2 := j1;
path2.ArcJoinB2L := j2;
end;
end;
end;
//path1.el1 := path1.l1;
//path1.el2 := path1.l2;
//path1.er1 := path1.r1;
//path1.er2 := path1.r2;
//path2.el1 := path2.l1;
//path2.el2 := path2.l2;
//path2.er1 := path2.r1;
//path2.er2 := path2.r2;
//18.11.2010 îïðåäåëÿåì òî÷êè, ïîäâåäåííûå èç ïàðàëåëüíûõ ëèíèé
path1.PointToParralelLine;
path2.PointToParralelLine;
end;
end;
//path1 := GetNetPathByComponID(163, TF_CAD(TPowerCad(Owner).Owner));
//if path1 <> nil then
// EmptyProcedure;
{if MovePtIntersect <> nil then
begin
PointList := TList.Create;
PointList.Add(@MovePtPath.r1);
PointList.Add(@MovePtPath.er1);
PointList.Add(@MovePtPath.r2);
PointList.Add(@MovePtPath.er2);
PointList.Add(@MovePtPath.l1);
PointList.Add(@MovePtPath.el1);
PointList.Add(@MovePtPath.l2);
PointList.Add(@MovePtPath.el2);
for k := 0 to PointList.Count - 1 do
begin
TempPt := PDoublePoint(PointList[k]);
//if (TempPt <> MovePtIntersect) and (TempPt <> MoveSPtIntersect) then
begin
TempPt^.x := TempPt^.x + MovePtDeltaX;
TempPt^.y := TempPt^.y + MovePtDeltaY;
end;
end;
FreeAndNil(PointList);
end;}
//Tolik -- 07/02/2017
FreeAndNil(xPaths);
//
FreeAndNil(arcPoints);
FreeAndNil(arcLPoints);
end;
procedure TNet.IntersectPaths(UseCols:Boolean=True);
var
i: Integer;
path: TNetPath;
begin
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(Paths[i]);
path.Empty1 := False;
path.Empty2 := False;
end;
for i := 0 to Structs.Count-1 do
if TnetStruct(Structs[i]) is TnetRow then
TNetROw(structs[i]).GetPipePoints;
for i := 0 to Points.Count-1 do
begin
IntersectCorner(i);
IntersectPipeCorner(i);
if usecols then
IntersectColCorner(i);
if usecols then
IntersectColPipeCorner(i);
end;
for i := 0 to Paths.Count -1 do
begin
path := TNetPath(Paths[i]);
path.CalculateExternSnaps;
end;
end;
procedure TNet.InvertSelPath;
var
index: Integer;
path: TNetPath;
begin
if SelIndex > 0 then
begin
index := SelIndex-1;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
if path.isArc then
begin
Path.inverted := not path.inverted;
RefreshPaths;
end;
end;
end;
end;
function TNet.isPointIn(x, y: Double): boolean;
var
i: Integer;
res: Boolean;
DEngine:TPCDrawEngine;
path: TNetPath;
struct: TnetStruct;
function CheckPath(APath: TNetPath; AIdx: Integer): Boolean;
begin
Result := false;
if APath <> nil then
if APath.IsPointIn(x,y) then
begin
//APath.Net.SrvDropFComponID;
if Not FFigureModification then //#From Oleg#
begin
if PointNear(APath.p1^, DoublePoint(x,y)) then //18.08.2011
SelectPt(APath.p1)
else if PointNear(APath.p2^, DoublePoint(x,y)) then
SelectPt(APath.p2)
else
SelectPath(AIdx+1, true);
end;
Result := True;
end;
end;
begin
result := false;
DEngine := TPCDrawing(Owner).DEngine;
for i := 0 to Structs.Count - 1 do
begin
struct := TnetStruct(Structs[i]);
if struct.IsPointIn(x, y) then
begin
SelIndex := i + 1;
SelType := stStruct;
Result := True;
exit;
end;
end;
if SelPt <> nil then
begin
if PointNear(PDoublePoint(Points[FSelPtIdx])^, DoublePoint(x,y)) then
begin
Result := True;
exit;
end;
end
else if (SelIndex <> 0) then
if CheckPath(SelPath, SelIndex-1) then
begin
Result := True;
exit;
end;
for i := 0 to Paths.Count - 1 do
begin
if i <> (SelIndex-1) then
begin
Path := TNetPath(paths[i]);
{if Path.IsPointIn(x,y) then
begin
if Not FFigureModification then //#From Oleg#
begin
//27.07.2011 SelIndex := i + 1;
//27.07.2011 SelType := stPath;
//18.08.2011 SelectPath(i+1, true);
//Path.TestShowPointsInfo;
if PointNear(Path.p1^, DoublePoint(x,y)) then //18.08.2011
SelectPt(Path.p1)
else if PointNear(Path.p2^, DoublePoint(x,y)) then
SelectPt(Path.p2)
else
SelectPath(i+1, true);
end;
Result := True;
exit;
end;}
if CheckPath(Path, i) then
begin
Result := True;
exit;
end;
end;
end;
end;
function TNet.IsPointOnWall(p: TDoublePoint): Boolean;
var
i: Integer;
path: TnetPath;
begin
result := false;
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(Paths[i]);
if (path.isPointIn(p.x,p.y)) then
begin
result := True;
exit;
end;
end;
end;
function TNet.LocatePoint(p: PDoublePoint; x, y: Double; allowCheckValid: Boolean=true): Boolean;
var
oldx,oldy: Double;
dx,dy: Double;
i: integer; //19.10.2010
RelNet: TNet; //19.10.2010
NetList: TList;
begin
Result := true; //19.10.2010
oldx := p.x;
oldy := p.y;
p.x := x;
p.y := y;
if allowCheckValid and not PathsValid(p) then
begin
p.x := oldx;
p.y := oldy;
Result := false;
end;
//19.10.2010
if Result then
begin
// Ñìåùåíèå îò ïðåäûäóùåé ïîçèöèè
dx := x - oldx;
dy := y - oldy;
// Ïðîâåðÿåì ìîãóò ëè âñå ñâÿçàííûå òî÷êè äðóãèõ îáúåêòîâ ïåðåìåòèòñÿ
for i := 0 to Self.FRelatedNets.Count - 1 do
begin
RelNet := TNet(Self.FRelatedNets[i]);
if RelNet.FRelatedMPoint <> nil then
begin
Result := RelNet.CheckLocatePoint(RelNet.FRelatedMPoint, x, y);
if Not Result then
Break; //// BREAK ////
end;
end;
if Result then
begin
if Assigned(FOnMovePoint) then //29.04.2011
FOnMovePoint(Self, p, GetPointID(p)); //29.04.2011
//23.05.2011 - Åñëè ýòî èñõîäíûé, òî ïðåðåäâèãàåì ñâÿçàííûå ïî ïîäêëþ÷åíèþ
if FRelatedMPoint = nil then
if Assigned(FOnDefineMoveObjects) and CanMoveJoined then
begin
NetList := TList.Create;
NetList.Assign(Self.FRelatedNets);
NetList.Insert(0, Self);
p.x := oldx;
p.y := oldy;
FOnDefineMoveObjects(Self, p, nil, NetList);
p.x := x;
p.y := y;
for i := 0 to NetList.Count - 1 do
TNet(NetList[i]).MoveJoinedPoints(dx, dy, false);
NetList.Free;
end;
for i := 0 to Self.FRelatedNets.Count - 1 do
begin
RelNet := TNet(Self.FRelatedNets[i]);
if RelNet.FRelatedMPoint <> nil then
begin
Result := RelNet.LocatePoint(RelNet.FRelatedMPoint, x, y, false);
if Not Result then
Break; //// BREAK ////
end;
RelNet.FRelatedMPoint := nil;
end;
end;
if Not Result then
begin
p.x := oldx;
p.y := oldy;
end;
end;
Self.FRelatedNets.Clear;
SetModified;
end;
Function TNet.MakePathArc(pArr: TDoublePointArr; dontRefresh: Boolean = False): TNetPath;
begin
end;
Function TNet.MakePath(pArr: TDoublePointArr; dontRefresh: Boolean = False): TNetPath;
var
i, k, p: Integer;
path: TNetPath;
cnt, pcnt: Integer;
points: TDoublePointArr;
p1, p2: TDoublePoint;
valid: Boolean;
wLen: Double;
delPaths: TList;
label ex;
begin
result := nil;
pCnt:= Length(pArr);
if pcnt < 2 then
exit;
if CheckLineOnLine(pArr) then
exit;
if not CheckSelfIntersection(pArr) then
exit;
if assigned(UndoProc) then
UndoProc;
if Paths.Count = 0 then
begin
result := CreatePaths(pArr, dontRefresh);
Exit;
end;
delPaths := TList.Create;
cnt := 0;
SetLength(points, cnt);
for i := 0 to pCnt - 2 do
begin
p1 := pArr[i];
p2 := pArr[i + 1];
wLen := GetLineLength(p1, p2);
valid := True;
if Not FDisableMergePaths then //15.10.2010
if FAllowDelPathOnMake then //26.09.2011
begin
k := 0;
repeat
path := TNetPath(Paths[k]);
if {(IsPointInLine(p1, p2, path.p1^, 1) and IsPointInLine(p1, p2, path.p2^, 1)) or }
(IsPointInLine(path.p1^, path.p2^, p1, 1, 0) and IsPointInLine(path.p1^, path.p2^, p2, 1, 0)) then
begin
if path.MLen < wLen then
begin
delPaths.Add(path);
end
else
begin
Valid := False;
end;
end
else
if (IsPointInLine(p1, p2, path.p1^, 1, 0) and IsPointInLine(p1, p2, path.p2^, 1, 0)){ or
(IsPointInLine(path.p1^, path.p2^, p1, 1) and IsPointInLine(path.p1^, path.p2^, p2, 1))} then
begin
if path.MLen > wLen then
begin
delPaths.Add(path);
end
else
begin
Valid := False;
end;
end;
k := k + 1;
until (k = Paths.Count) or (not valid);
end;
if Valid then
begin
p := 0;
while p < Delpaths.Count do
begin
DeletePath(TNetPath(Delpaths[p]));
p := p + 1;
end;
if cnt = 0 then
begin
cnt := cnt + 1;
SetLength(points, cnt);
points[cnt - 1] := p1;
end;
cnt := cnt + 1;
SetLength(points, cnt);
points[cnt - 1] := p2;
end
else
begin
result := CreatePaths(points, True);
cnt := 0;
SetLength(points, cnt);
end;
delPaths.Clear;
end;
delpaths.Free;
if cnt > 0 then
begin
result := CreatePaths(points, True);
end;
Ex:
if not DontRefresh then
RefreshPaths;
end;
function TNet.MakePathOnShadow(pArr: TDoublePointArr; dontRefresh: Boolean = False): TnetPath;
var
SavedThick: Double;
begin
SavedThick := WallThick;
try
WallThick := GArchEngine.GetLastObjSize(aoskPathWidth, SavedThick);
Result := MakePath(pArr, dontRefresh);
finally
WallThick := SavedThick;
end;
end;
procedure TNet.MenuClicked(CommandId: integer);
var
mnIdx: Integer;
merdIdx: Integer;
begin
{$ifndef limited}
mnIdx := commandId - MenuIndex;
if mnIdx < 0 then
exit;
case mnIdx of
0: DeleteSelected;
1: AddDoor;
2: AddWindow;
3: AddCol;
4: OpenAllWindows;
5: AddCols;
end;
{$endif limited}
end;
procedure TNet.Mirror(Point1, Point2: TDoublePoint);
var
a:Integer;
pt: PDoublePoint;
begin
for a:= 0 to Points.Count - 1 do
begin
pt := PDoublePoint(Points[a]);
pt^ := GetSymetricPoint(pt^,Point1,Point2);
end;
//08.05.2012 - Ìåíÿåì ïåðåâîðîò íèøàì, òàê êàê ïîñëå Mirror îíè âûãëÿäÿò ñ äðóãèõ ñòîðîí ñåãìåíòîâ
RotateAllNiche;
SetModified; //03.02.2012 ResetRegion;
end;
procedure TNet.Move(deltax, deltay: Double);
var
i: Integer;
p: PDoublePoint;
TraceFigure: TFigure;
ShiftState: TShiftState;
MoveAllPoints: Boolean;
begin
//01.10.2010
//if DragMove then
// begin
// FFigureModification := false; //#From Oleg#
//
// Tpowercad(Owner).SnapLocked := False;
// TraceFigure := nil;
// if assigned(owner) and assigned(TPowercad(owner).TraceFigure) then
// TRaceFigure := TPowercad(owner).TraceFigure;
// if assigned(TraceFigure) then
// begin
// if TraceFigure is TDoorTrace then
// TDoorTrace(TraceFigure).EndTrace;
// if TraceFigure is TPathTrace then
// TPathTrace(TraceFigure).EndTrace;
// end;
// end
// else
// begin
// for i := 0 to Points.Count - 1 do
// begin
// p := PDoublePoint(Points[i]);
// p.x := p.x + deltax;
// p.y := p.y + deltay;
// end;
// ResetRegion;
// end;
//24.04.2012 - Åñëè âðåìÿ íà DragOver áûëî î÷åíü ìàëîå, òî ñ÷èòàåì ÷òî íà êëèêå ñëó÷àéíî ïðîèçîøåë move, è íè÷åãî íå äåëàåì
if DragMove then
if TPowerCad(Owner).FDragOverTime < 150 then
begin
EmptyProcedure;
Exit; ///// EXIT /////
end;
MoveAllPoints := FMoveAllPoints;
if Not MoveAllPoints then
begin
if Not DragMove and
//Not((GetKeyState(VK_SHIFT)AND$80)=$80)
//Not((GetKeyState(VK_MENU)AND$80)=$80)
//(Not((GetKeyState(VK_SHIFT)AND$80)=$80) and Not((GetKeyState(VK_CONTROL)AND$80)=$80))
( (ssShift in GGlobalShiftState) and (ssCtrl in GGlobalShiftState))
then
MoveAllPoints := true
else if Assigned(Parent) and (Parent is TFigureGrp) then
MoveAllPoints := true;
end;
if MoveAllPoints then
begin
// Ïåðåìåùàåì âåñü Net
for i := 0 to Points.Count - 1 do
begin
p := PDoublePoint(Points[i]);
p.x := p.x + deltax;
p.y := p.y + deltay;
end;
if Assigned(FOnMove) then
FOnMove(Self);
SetModified; //03.02.2012 ResetRegion;
end
else
begin
FFigureModification := false; //#From Oleg#
Tpowercad(Owner).SnapLocked := False;
TraceFigure := nil;
if assigned(owner) and assigned(TPowercad(owner).TraceFigure) then
TRaceFigure := TPowercad(owner).TraceFigure;
if assigned(TraceFigure) then
begin
if TraceFigure is TDoorTrace then
TDoorTrace(TraceFigure).EndTrace;
if TraceFigure is TPathTrace then
TPathTrace(TraceFigure).EndTrace;
end
// åñëè ïåðåìåùåíèå êóðñîðàìè? ïåðåìåùàåì âûäåëåííûé ñåãìåíò
else if Not DragMove then
begin
//MovePath(SelPath, deltax,deltay);
TraceFigure := CreateMoveTrace;
if TraceFigure is TPathTrace then
begin
if ssShift in GGlobalShiftState then
begin
TPathTrace(TraceFigure).SnappedGrid := false;
TPathTrace(TraceFigure).SnappedGuide := false;
end;
TPathTrace(TraceFigure).Move(deltax,deltay);
TPathTrace(TraceFigure).EndTrace;
end;
//Tolik 18/10/2017 --
//TraceFigure.Free;
FreeAndNil(TraceFigure);
//
end;
end;
end;
procedure TNet.MovePath(path: TNetPath; dx, dy: Double);
var
IsMoved: Boolean;
SamePaths: TList;
i, j, IntersectType: Integer;
NetPath: TNetPath;
MovedPoints: TList;
NetPathConnectedToMove: Boolean;
BeforeP1, BeforeP2: TDoublePoint;
procedure MovePathPoint(APath: TNetPath; Apt: PDoublePoint);
begin
if MovedPoints.IndexOf(APt) = -1 then
begin
Apt^.x := Apt^.x + dx;
Apt^.y := Apt^.y + dy;
MovedPoints.Add(Apt);
if Assigned(APath.FOnMove) then
APath.FOnMove(Self);
end;
end;
begin
if path <> nil then //01.10.2010
begin
IsMoved := true; //22.08.2011
//22.08.2011 - Ñåãìåíòû íà òåõ æå ñàìèõ êîîðäèíàòàõ
SamePaths := nil;
if Not (ssAlt in GGlobalShiftState) then
for i := 0 to Paths.Count - 1 do
begin
NetPath := TNetPath(Paths[i]);
if (NetPath <> Path) and Not Path.Connected(NetPath) {and (NetPath.GetLenByPoints(NetPath.p1^, NetPath.p2^) > 0)} then
begin
IntersectType := Path.CmpIntersectPath(NetPath);
if IntersectType in [citEqual, citEntry, citAbsorb] then
begin
NetPathConnectedToMove := false;
if IntersectType <> citAbsorb then
if SamePaths <> nil then
for j := 0 to SamePaths.Count - 1 do
begin
if TNetPath(SamePaths[j]).Connected(NetPath) then
begin
NetPathConnectedToMove := true;
Break; //// BREAK ////
end;
end;
// Åñëè ñåãìåíò íå ïîäêëþ÷åí òî÷êîé ê ïåðåìåùàåìîìó
if Not NetPathConnectedToMove then
begin
if SamePaths = nil then
SamePaths := TList.Create;
SamePaths.Add(NetPath);
end;
end;
end;
end;
BeforeP1 := Path.p1^;
BeforeP2 := Path.p2^;
Path.Move(dx,dy);
// Tolik -- 02/02/2017 --
RefreshPoints;
RefreshColPositions;
RefreshPaths;
//
if (Not PathsValid(path.p1)) or (Not PathsValid(path.p2)) then
begin
Path.Move(-dx,-dy);
begin
IsMoved := false; //22.08.2011
RefreshPoints;
RefreshColPositions;
RefreshPaths;
end;
end;
// Tolik -- 02/02/2017 --
if isMoved then
begin
isMoved := Self.CheckDeleteInnerWalls;
if not isMoved then
begin
Path.Move(-dx,-dy);
RefreshPoints;
RefreshColPositions;
RefreshPaths;
end;
end;
if IsMoved then //22.08.2011
begin
if SamePaths <> nil then //22.08.2011
begin
MovedPoints := TList.Create;
for i := 0 to SamePaths.Count - 1 do
begin
NetPath := TNetPath(SamePaths[i]);
if (NetPath.Net.FJoinedMovePoints.IndexOf(NetPath.p1) = -1) and
(NetPath.Net.FJoinedMovePoints.IndexOf(NetPath.p2) = -1) and
(NetPath.Net.FJoinedMovePaths.IndexOf(NetPath) = -1) then
begin
//22.09.2011 NetPath.Move(dx,dy);
MovePathPoint(NetPath, NetPath.p1);
MovePathPoint(NetPath, NetPath.p2);
end;
end;
MovedPoints.Free;
end;
//08.05.2012 - ïðîâåðÿåì, áûëî ëè ïåðåìåùåíèå ÷åðåç ñåãìåíòû (åñòü ëè ñåãìåíò ëåæàùèé íà òðàåêòîðèè ïåðåìåùåíèÿ)
//08.05.2012 åñëè äà, òî ìåíÿåì íèøàì íàïðàâëåíèå, òàê êàê ïîñëå ïåðåâîðà÷èâàíèÿ îíè ìåíÿþò íàïðàâëåíèå
if ExistsPathOnPathTrajectory(path, @BeforeP1, @BeforeP2) then
RotateAllNiche;
// Tolik 19/10/2016---
CorrectNetPathPosbyRelatedPath(Path, dx, dy);
//03.02.2012 ResetRegion;
//03.02.2012 Modified := True;
SetModified;
DoResize;
end;
if SamePaths <> nil then //22.08.2011
SamePaths.Free;
end; //01.10.2010
end;
procedure TNet.OpenSelPath;
var
index: Integer;
path: TNetPath;
begin
if SelIndex > 0 then
begin
index := SelIndex - 1;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
if not path.Border then
begin
if Path.WType = wtOpen then
Path.WType := wtWall
else
if Path.WType = wtWall then
Path.WType := wtOpen;
Path.WType := wtOpen;
RefreshPaths;
end;
end;
end;
end;
function TNet.PathIndex(p1, p2: TDoublePoint): Integer;
var
i: Integer;
px: TnetPath;
begin
result := -1;
for i := 0 to Paths.Count - 1 do
begin
px := TnetPath(Paths[i]);
if (EQDP(p1,px.p1^) and EQDP(p2,px.p2^)) or (EQDP(p1,px.p2^) and EQDP(p2,px.p2^)) then
begin
result := i;
exit;
end;
end;
end;
function TNet.PathsValid(p:PDoublePOint): Boolean;
var
i,k: Integer;
path1,path2: TnetPath;
CanOverlap: Boolean;
begin
result := true;
for i := 0 to Paths.Count - 1 do
begin
Path1 := TnetPath(Paths[i]);
if (path1.p1 = p) or (path1.p2 = p) then
begin
for k := 0 to Paths.Count - 1 do
begin
Path2 := TNetPath(paths[k]);
if (path1 <> path2) and path1.overlaps(path2) then
begin
CanOverlap := false;
if Assigned(FOnPathsOverlapQuery) then
FOnPathsOverlapQuery(Path1, Path2, p, CanOverlap);
if Not CanOverlap then
begin
result := false;
exit;
end;
end;
end;
end;
end;
end;
function TNet.PointIndex(p: TDoublePoint): Integer;
var
i: Integer;
px: PDoublePoint;
begin
result := -1;
for i := 0 to Points.Count - 1 do
begin
px := PDoublePoint(Points[i]);
if EQDP(p,px^) then
begin
result := i;
exit;
end;
end;
end;
procedure TNet.RefreshPaths(aUpdateRegion: Boolean=true);
var
i: Integer;
path: TNetPath;
begin
FPerpendPoints := TList.Create;
try
MarkBrokenPaths;
CalculatePathPoints;
IntersectPaths;
if assigned(XDrawEngine) and aUpdateRegion then
UpdatePathRegion(XDrawEngine);
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(paths[i]);
path.refresh;
end;
FIsLoadedBounds := false; //30.01.2012
// Remove Saved 3D Model from Stream if FPlan changed
if GSaved3DModelExist then
begin
// Remove3DModelStream;
// GSaved3DModelExist := False;
end;
finally
FreeAndNil(FPerpendPoints);
end;
end;
procedure TNet.RefreshRegions(DEngine:TPCDrawEngine);
begin
end;
procedure TNet.ResetRegion;
begin
Modified := True;
end;
procedure TNet.Rotate(aAngle: Double; cPoint: TDoublePoint);
var
i: Integer;
p: PDoublePoint;
point1: TDoublePoint;
begin
if assigned(UndoProc) then
UndoProc;
//cPoint := PDoublePoint(Points[1])^;
for i := 0 to Points.Count - 1 do
begin
p := PDoublePoint(Points[i]);
point1 := RotatePoint(cPoint,p^,aAngle);
p.x := point1.x;
p.y := point1.y;
end;
SetModified; //03.02.2012 ResetRegion;
end;
procedure TNet.BeforeAllScale(Sender: TObject);
begin
if Assigned(FOnScale) then
begin
SavePoints; // Çàïîìèíàåì êîîðäèíàòû òî÷åê
//SaveScaledPoints;
end;
if Assigned(FOnScaleBefore) then
FOnScaleBefore(Self);
end;
procedure TNet.ScaleAllEvent(Sender: TObject);
begin
if Assigned(FOnScale) then
FOnScale(Self, 0, 0, nil);
end;
procedure TNet.AfterAllScale(Sender: TObject);
begin
if Assigned(FOnScale) then
begin
ClearSavedPoints;
ClearSavedScaledPoints;
end;
if Assigned(FOnScaleAfter) then
FOnScaleAfter(Self);
end;
procedure TNet.Scale(px, py: Double; rPoint: TDoublepoint);
var
i, j: Integer;
p: PDoublePoint;
point1: TDoublePoint;
Path: TNetPath;
Door: TNetDoor;
OldLen: double;
newdp1, newdp2, newp1: TDoublePoint;
Col: TNetCol;
begin
// òî÷êè
for i := 0 to Points.Count - 1 do
begin
p := PDoublePoint(Points[i]);
point1 := ScalePoint(rPoint, p^, px, py);
p.x := point1.x;
p.y := point1.y;
//p^.x := rPoint.x - (rPoint.x - p^.x)*px;
//p^.y := rPoint.y - (rPoint.y - p^.y)*py;
end;
// îáúåêòû òèïà äâåðè/îêíà â ñåãìåíòàõ
for i := 0 to Paths.Count - 1 do
begin
Path := TNetPath(Paths[i]);
for j := 0 to Path.Doors.Count - 1 do
begin
Door := TNetDoor(Path.Doors[j]);
newdp1 := ScalePoint(rPoint, Door.p1, px, py);
newdp2 := ScalePoint(rPoint, Door.p2, px, py);
Door.p1 := newdp1;
Door.p2 := newdp2;
OldLen := Door.Len;
Door.Len := SQRT(SQR(newdp1.x - newdp2.x) + SQR(newdp1.y - newdp2.y));
Door.Start := Door.Start * (Door.Len / OldLen);
end;
end;
// êîëîííû
for i := 0 to Structs.Count - 1 do
begin
if TnetStruct(Structs[i]) is TNetCol then
begin
Col := TnetCol(Structs[i]);
Col.w := Col.w * px;
Col.h := Col.h * py;
end;
end;
SetModified; //03.02.2012 ResetRegion;
if Assigned(FOnScale) then //23.09.2011
begin
SaveScaledPoints; // Çàïîìèíàåì êîîðäèíàòû òî÷åê ïîñëå scale
end;
end;
function TNet.TraceModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean;
var
tf: Tnet;
oldPt: TDoublePoint;
p: PDoublePoint;
SavedPt: PDoublePoint;
dx, dy, delta: Double;
oPath, path: TnetPath;
pIdx: Integer;
i: integer; //19.10.2010
//Angle: Double;
RelNet: TNet;
SavedArcAng: Double;
SavedArcCenter: TDoublePoint;
CanRefresh: Boolean;
begin
Result := false;
if not assigned(TraceFigure) then
exit;
tf := nil; //#From Oleg# //14.09.2010
if (mp.PType = ptPolyPoint) or (mp.PType = ptRectPoint) or (mp.PType = ptGroupPoint) then
tf := Tnet(TraceFigure);
if (mp.PType = ptPolyPoint) and (mp.Tag > -1) and (mp.Tag < tf.Points.Count) then
begin
CanRefresh := false; //24.05.2011
if (GetTickCount - FLastTickTraceRefresh) > 40 then
begin
FLastTickTraceRefresh := GetTickCount;
CanRefresh := true;
end;
CanRefresh := true;
// SnapModPoint(x, y, mp, tf);
p := PDoublePoint(tf.Points[mp.tag]);
oldPt := p^;
p.x := x;
p.y := y;
if Not (ssShift in GGlobalShiftState) then //12.10.2010
p^ := PointToOrthogonal(p, x, y, tf); //12.10.2010
//dx := p^.x - oldPt.x; //23.05.2011
//dy := p^.y - oldPt.y; //23.05.2011
dx := 0;
dy := 0;
if CanMoveJoined then
begin
// Èùåì ñìåùåíèå îòíîñèòåëüíî íà÷àëüíîé ïîçèöèè
SavedPt := tf.GetSavedPtByPoint(p);
if SavedPt <> nil then
begin
dx := p^.x - SavedPt^.x; //23.05.2011
dy := p^.y - SavedPt^.y; //23.05.2011
end;
tf.MoveJoinedPoints(dx, dy, true);
end;
//GCadForm.mProtocol.Lines.Add('dx - '+FloatToStr(dx)+' dy - '+FloatToStr(dy));
for i := 0 to tf.FRelatedNets.Count - 1 do
begin
RelNet := TNet(tf.FRelatedNets[i]);
if (RelNet.FRelatedMPoint <> nil) then
begin
RelNet.FRelatedMPoint^ := p^;
end;
if CanMoveJoined then
RelNet.MoveJoinedPoints(dx, dy, true); //23.05.2011
if CanRefresh then
RelNet.RefreshPaths; //21.04.2011
end;
if CanRefresh and Not EQDP(p^, oldPt) then
begin
//21.04.2011 tf.CalculatePathPoints; //22.10.2010 ïåðåñ÷èòàòü äàííûå äëÿ àðîê
//tf.DefineInOutPoints; //21.04.2011
tf.RefreshPaths; //21.04.2011
end;
// NormalizeKnot(p,tf);
end
else
if (mp.PType = ptRectPoint) and (mp.Tag > -1) and (mp.Tag < tf.Paths.Count) then
begin
SnapModPoint(x, y, mp, Tnet(TraceFigure));
dx := x - mp.CoordX;
dy := y - mp.CoordY;
Path := TnetPath(tf.Paths[mp.Tag]);
tf.EqualTracePaths;
Path.Move(dx, dy);
end
else
if (mp.PType = ptGroupPoint) and (mp.Tag > -1) and (mp.Tag < tf.Paths.Count) then
begin
SnapModPoint(x, y, mp, Tnet(TraceFigure));
dx := x - mp.CoordX;
dy := y - mp.CoordY;
Path := TnetPath(tf.Paths[mp.Tag]);
tf.EqualTracePaths;
tf.MoveSatih(path, dx, dy, False);
if path.isArc then //10.01.2011
begin
Path.ArcCenter := Path.Opath.ArcCenter;
Path.ArcCenter.x := Path.ArcCenter.x + dx;
Path.ArcCenter.y := Path.ArcCenter.y + dy;
//Path.Net.CalculatePathPoints;
Path.l1 := MovePoint(Path.Opath.l1, dx, dy);
Path.l2 := MovePoint(Path.Opath.l2, dx, dy);
Path.r1 := MovePoint(Path.Opath.r1, dx, dy);
Path.r2 := MovePoint(Path.Opath.r2, dx, dy);
end;
Tnet(TraceFigure).RefreshPaths; //22.04.2011
end
else
if (mp.PType = ptControlPoint) and (mp.SeqNbr > 0) then
begin
TDoorTrace(TraceFigure).Locate(x, y);
end
else
if (mp.PType = ptControlPoint) and (mp.SeqNbr = -2) then
begin
TraceFigure.Move(TPowercad(CadControl).TraceDeltax, TPowercad(CadControl).TraceDeltay);
end
//11.10.2010
else
if (mp.PType = ptControlPoint) and (mp.SeqNbr = -3) then
begin
TDoorTrace(TraceFigure).MovePoint(DoublePoint(mp.CoordX, mp.CoordY), x, y);
end
//22.10.2010
else
if mp.PType = ptArcControl then
begin
tf := TNet(TraceFigure);
Path := TnetPath(tf.Paths[mp.Tag]);
// òî÷êó ñòàâèì ïåðïåíäèêóëÿðíî Path
//PointToLine(Path.p1^, Path.p2^, x, y);
Path.ArcCenter := DoublePoint(x, y);
if Path.Inverted then
Path.ArcAng := GetRadOf2Lines(Path.p1^, Path.ArcCenter, Path.p2^)
else
Path.ArcAng := GetRadOf2Lines(Path.p2^, Path.ArcCenter, Path.p1^);
//21.04.2011 tf.CalculatePathPoints;
tf.RefreshPaths; //21.04.2011
end;
end;
procedure TNet.UpdateAllRegions(Dengine:TPCDrawEngine);
begin
RefreshPaths;
if assigned(XDrawEngine) then
UpdatePathRegion(Dengine);
if assigned(XDrawEngine) then
RefreshRegions(Dengine);
end;
procedure TNet.UpdateMenu(var PopMenu: TPopUpMenu; var sIndex: integer);
var
mnItem,mnSub,mnSubSub: TMenuItem;
i,xIndex: Integer;
begin
if not ContextMenu then
exit;
menuIndex := sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Caption := 'Delete Selection';
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Caption := '-';
PopMenu.Items.Add(mnItem);
if SelPath <> nil then
begin
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex + 1;
mnItem.Caption := 'Add Door';
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex + 2;
mnItem.Caption := 'Add Window';
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex + 3;
mnItem.Caption := 'Add Column';
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex + 4;
mnItem.Caption := 'Divide Wall';
PopMenu.Items.Add(mnItem);
end;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex + 5;
mnItem.Caption := 'Open All Windows';
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex + 6;
mnItem.Caption := 'Create All Columns';
PopMenu.Items.Add(mnItem);
sIndex := SIndex + 7;
end;
procedure TNet.UpdatePathRegion(Dengine:TPCDrawEngine);
var
i: Integer;
path: TNetPath;
begin
if PathRgn <> 0 then // Tolik 21/11/2019 --
DeleteObject(PathRgn);
pathRgn := CreateRectRgn(0,0,0,0);
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(Paths[i]);
path.UpdateRegion(DEngine);
CombineRgn(PathRgn,PathRgn,path.Region,RGN_OR);
end;
end;
function TNet.AddDoor(aDoorObjType: TDoorObjType=dotDoor; aLen: Double=-1): TNetDoor;
var
index, i: Integer;
path: TNetPath;
region, wLen: Double;
begin
Result := nil;
if (SelIndex > 0) and (selType = stPath) then
begin
index := SelIndex -1 ;
if assigned(undoProc) then
UndoProc;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
wLen := aLen;
if wLen = -1 then
begin
wLen := 15;
if path.AbsLen < 15 then
wLen := path.AbsLen * 0.9;
//Path.NewDoor(15, wLen, dotDoor);
end;
Result := Path.NewDoor(15, wLen, aDoorObjType);
RefreshPaths;
end;
end;
end;
function TNet.AddWindow(aLen: Double=-1): TNetDoor;
var
index, i: Integer;
path: TNetPath;
wLen: Double;
begin
Result := nil;
if (SelIndex > 0) and (selType = stPath) then
begin
index := SelIndex - 1;
if assigned(undoProc) then
UndoProc;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
wLen := aLen;
if wLen = -1 then
begin
wLen := path.AbsLen * 0.7;
if wLen > 50 then
wLen := 50;
end;
Result := Path.NewDoor(15, wLen, dotWindow);
RefreshPaths;
end;
end;
end;
Function TNet.AddNetCol(p: TdoublePoint):TNetCol;
var
p1: PDoublePoint;
col: TnetCol;
begin
result := nil;
if not assigned(p1) then
exit;
p1 := InsertKnot(p, true);
col := TnetCol.Create(Self, p1);
Col.SetPosition;
Structs.Add(col);
result := col;
RefreshPaths;
end;
Function TNet.AddNetRow(xp1, xp2: TdoublePoint): TNetRow;
var
p1, p2: PDoublePoint;
row: TnetRow;
begin
Result := nil;
p1 := InsertKnot(xp1, true);
p2 := InsertKnot(xp2, true);
row := TnetRow.Create(Self, p1, p2);
Structs.Add(row);
result := row;
RefreshPaths;
end;
procedure TNet.MovePathDoor(path: TNetPath; delta: Double);
begin
Path.MoveDoor(Delta);
//03.02.2012 ResetRegion;
//03.02.2012 Modified := True;
SetModified;
end;
procedure TNet.ColPosition(pos: Integer);
var
index: Integer;
struct: TNetStruct;
begin
if SelIndex > 0 then
begin
index := SelIndex-1;
if index < Structs.Count then
begin
struct := TNetStruct(Structs[Index]);
if Struct is TNetCol then
begin
TNetCol(Struct).Position := pos;
end;
end;
end;
RefreshPaths;
end;
function TNet.GetPathOfPoint(x, y: Double): TnetPath;
var
i: Integer;
path: TnetPath;
begin
result := nil;
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(Paths[i]);
if (path.isPointIn(x,y)) then
begin
result := path;
exit;
end;
end;
end;
procedure TNet.RefreshColPositions;
var
i: Integer;
begin
for i := 0 to Structs.Count - 1 do
if TNetStruct(Structs[i]) is TNetcol then
TNetCol(Structs[i]).SetPosition;
end;
procedure TNet.AddCols;
var
i: Integer;
p: PDoublePoint;
xPoints: TList;
col: TnetCol;
begin
if assigned(UndoProc) then
UndoProc;
xPoints := TList.Create;
for i := 0 to Points.Count - 1 do
begin
xPoints.Add(Points[i]);
end;
try
for i := 0 to Structs.Count - 1 do
begin
if TNetStruct(Structs[i]) is TNetCol then
begin
xPoints.Remove(TNetCol(Structs[i]).p1);
end;
end;
except
// ShowMessage(CPowerCadMessage + 'TNet.AddCols');
end;
for i := 0 to xPoints.Count - 1 do
begin
p := pDoublePoint(xPoints[i]);
col := TnetCol.Create(Self,p);
Col.SetPosition;
Structs.Add(col);
RefreshPaths;
end;
end;
procedure TNet.RefreshPoints;
var
i: Integer;
xPath: TnetPath;
Struct: TNetStruct;
p: PDoublePoint;
xPoints: TList;
begin
xPoints := TList.Create;
for i := 0 to Points.Count - 1 do
begin
xPoints.Add(Points[i]);
end;
try
for i := 0 to Structs.Count - 1 do
begin
if TNetStruct(Structs[i]) is TNetCol then
begin
xPoints.Remove(TNetCol(Structs[i]).p1);
end
else if TNetStruct(Structs[i]) is TNetRow then
begin
xPoints.Remove(TNetRow(Structs[i]).p1);
xPoints.Remove(TNetRow(Structs[i]).p2);
end;
end;
For i := 0 to Paths.Count - 1 do
begin
xPath := TnetPath(Paths[i]);
xPoints.Remove(xPath.p1);
xPoints.Remove(xPath.p2);
end;
for i := 0 to xPoints.Count - 1 do
begin
p := PDoublePoint(xPoints[i]);
//04.10.2010 Points.Remove(p);
//04.10.2010 Dispose(p);
DeletePoint(p);
end;
except
// ShowMessage(CPowerCadMessage + 'TNet.RefreshPoints');
end
end;
procedure TNet.CombinePathsOfKnot(p: PDoublePoint);
var
xList: TList;
xp1,xp2: TDoublePoint;
a1,a2: Double;
path1,path2: TNetPath;
i: Integer;
begin
xList:= TList.Create;
GetStructsOfKnot(p,xList);
if xList.Count > 0 then
//Tolik -- 07/02/2017 --
// exit;
begin
FreeAndnil(xList);
exit;
end;
//
GetPathsOfKnot(p,xList);
if xList.Count = 2 then
begin
path1 := TnetPath(xList[0]);
path2 := TnetPath(xList[1]);
xp1 := path1.OtherPoint(p)^;
xp2 := path2.OtherPoint(p)^;
a1 := GetRadOfLine(p^,xp1);
a2 := GetRadOfLine(p^,xp2);
if EQD(abs(a1 - a2), pi) then
begin
path1.p1 := path1.OtherPoint(p);
path1.p2 := path2.OtherPoint(p);
paths.remove(path2);
for i := 0 to path2.Doors.Count - 1 do
begin
path1.Doors.Add(path2.Doors[i]);
end;
path2.Doors.Clear;
path2.Free;
//04.10.2010 Points.Remove(p);
//04.10.2010 Dispose(p);
DeletePoint(p);
end;
end;
xList.Free;
end;
procedure TNet.GetStructsOfKnot(p: PDoublePoint; var xStructs: TList);
var
i: Integer;
begin
for i := 0 to Structs.Count - 1 do
begin
if TNetStruct(Structs[i]).IsKnotIn(p) > -1 then
xStructs.Add(Structs[i]);
end;
end;
procedure TNet.DeleteSelected;
var
index: Integer;
Path: TnetPath;
Struct: TnetStruct;
Stair: TFigure;
begin
{$ifndef limited}
if (SelType = stPath) and (SelIndex > 0) then
begin
index := SelIndex - 1;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
if path.DoorIndex = -1 then
begin
DeletePath(Path);
SelectPath(0); //27.07.2011 SelIndex := 0;
end
else
begin
Path.DeleteDoor;
end;
end;
end
else
if (SelType = stStruct) and (SelIndex > 0) then
begin
index := SelIndex - 1;
if index < Structs.Count then
begin
Struct := TNetStruct(Structs[Index]);
DeleteStruct(Struct);
SelIndex := 0;
end;
end;
//03.02.2012 ResetRegion;
//03.02.2012 Modified := True;
SetModified;
{$endif limited}
end;
procedure TNet.DeleteStruct(Struct: TNetStruct);
var
i: Integer;
begin
Structs.Remove(Struct);
For i := 0 to Struct.Points.Count-1 do
begin
CombinePathsOfKnot(PDoublePoint(Struct.Points[i]));
end;
RefreshPoints;
Struct.free;
RefreshPaths;
end;
function TNet.FindPathOfPoints(p1, p2: TDoublePOint): TNetPath;
var
i: Integer;
path: TnetPath;
begin
result := nil;
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(Paths[i]);
if path.AreYou(p1,p2) then
begin
result := path;
exit;
end;
end;
end;
procedure TNet.OpenAllWindows;
var
i: Integer;
path: TnetPath;
wLen: Double;
begin
if assigned(UndoProc) then
UndoProc;
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(Paths[i]);
if (path.Border) and (path.Doors.Count = 0) and (path.AbsLen >= 20) then
begin
wLen := path.AbsLen * 0.7;
if wLen > 50 then
wLen := 50;
path.NewDoor(15, wLen, dotWindow);
end;
end;
RefreshPaths;
end;
procedure TNet.SetWallType(wt: TWallType);
var
index: Integer;
path: TNetPath;
begin
if SelIndex > 0 then
begin
index := SelIndex - 1;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
if (wt = wtHalf) and (not path.border) then
exit;
if path.border and (wt = wtOpen) then
wt := wtWall;
Path.WType := wt;
if (path.WType <> wtWall) then
begin
path.DeleteDoors;
end;
RefreshPaths;
end;
end;
end;
procedure TNet.SetArcPath(a: Boolean);
var
index: Integer;
path: TNetPath;
begin
if (SelType = stPath) and (SelIndex > 0) then
begin
index := SelIndex-1;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
Path.isArc := a;
RefreshPaths;
end;
end;
end;
procedure TNet.SetArcAng(val: Double);
var
index: Integer;
path: TNetPath;
ang: double;
begin
if (SelType = stPath) and (SelIndex > 0) then
begin
index := SelIndex-1;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
if path.isArc then
begin
Path.ArcAng := val;
RefreshPaths;
end;
end;
end;
end;
procedure TNet.ColAngle(ang: double);
var
index: Integer;
struct: TNetStruct;
begin
if SelIndex > 0 then
begin
index := SelIndex-1;
if index < Structs.Count then
begin
struct := TNetStruct(Structs[Index]);
if Struct is TNetCol then
begin
TNetCol(Struct).Angle := ang;
end;
end;
end;
end;
procedure TNet.ColHeight(ch: double);
var
index: Integer;
struct: TNetStruct;
begin
if SelIndex > 0 then
begin
index := SelIndex-1;
if index < Structs.Count then
begin
struct := TNetStruct(Structs[Index]);
if Struct is TNetCol then
begin
TNetCol(Struct).h := ch;
end;
end;
end;
end;
procedure TNet.ColWidth(cw: double);
var
index: Integer;
struct: TNetStruct;
begin
if SelIndex > 0 then
begin
index := SelIndex-1;
if index < Structs.Count then
begin
struct := TNetStruct(Structs[Index]);
if Struct is TNetCol then
begin
TNetCol(Struct).W := cw;
end;
end;
end;
end;
procedure TNet.RowThick(th: double);
var
index: Integer;
struct: TNetStruct;
begin
if SelIndex > 0 then
begin
index := SelIndex-1;
if index < Structs.Count then
begin
struct := TNetStruct(Structs[Index]);
if Struct is TNetRow then
begin
TNetRow(Struct).Thick := th;
end;
end;
end;
end;
procedure TNet.DoorLen(ww: Double);
var
index: Integer;
path: TNetPath;
door: TnetDoor;
begin
if SelIndex > 0 then
begin
index := SelIndex - 1;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
door := Path.ActiveDoor;
if assigned(door) then
begin
door.Len := ww;
RefreshPaths;
end;
end;
end;
end;
procedure TNet.SetPropertyFromStream(xCode: Byte; data: pointer; size: integer);
var
pCnt,i,xsize: Integer;
p: PDoublePoint;
xd, yd: Double;
SubStream, fStream: TMemoryStream;
path: TnetPath;
struct: TnetStruct;
regName: String;
rver: Byte;
SIndex: Integer;
Stair: TFigure;
alan: Byte;
DoorNbr,SahNo: Integer;
txMar,tymar: Double;
// test
PosBegin: Integer;
PosEnd: Integer;
Delta: Integer;
OldPlan: Boolean;
xInt: Integer; //#From Oleg# //04.10.2010
begin
case xCode of
92: FillWalls := Bool(PByte(Data)^);
93: WorldDim := Bool(PByte(Data)^);
20: MapScale := PInt(Data)^;
//21: FID := PInt(Data)^;
21: FComponID := PInt(Data)^;
220: WallThick := PDouble(Data)^;
// MapScale
239: MapScale := pDouble(data)^;
150: begin //points
SubStream := TMemoryStream.Create;
SubStream.Write(pByte(data)^, size);
SubStream.Position := 0;
pCnt := Size div 16;
for i := 1 to pCnt do
begin
SubStream.read(xd, 8);
SubStream.read(yd, 8);
new(p);
p^.x := xd;
p^.y := yd;
Points.Add(p);
FPointIDs.Add(Pointer(0)); //#From Oleg# //04.10.2010
end;
SubStream.Free; //#From Oleg# //04.10.2010
end;
151: begin //paths
SubStream := TMemoryStream.Create;
SubStream.Write(pByte(data)^, size);
SubStream.Position := 0;
SubStream.Read(pCnt, 4);
// TEST
PosBegin := SubStream.Position;
path := TnetPath.CreateFromStream(SubStream, Self, False);
PosEnd := SubStream.Position;
Delta := PosEnd - PosBegin;
if Delta = 27 then
OldPlan := True
else
OldPlan := False;
SubStream.Position := 4;
for i := 1 to pCnt do
begin
path := TnetPath.CreateFromStream(SubStream, Self, OldPlan);
if assigned(path) then
Paths.Add(Path);
end;
SubStream.Free;
XDrawEngine := TPCDrawing(Self.Owner).DEngine;
RefreshPaths;
end;
152: begin //structs
SubStream := TMemoryStream.Create;
SubStream.Write(pByte(data)^, size);
SubStream.Position := 0;
SubStream.Read(pCnt, 4);
for i := 1 to pCnt do
begin
struct := TnetStruct.CreateFromStream(SubStream, Self);
if assigned(struct) then
Structs.Add(struct);
end;
SubStream.Free;
end;
153: // point ids //#From Oleg# //04.10.2010
begin
SubStream := TMemoryStream.Create;
SubStream.Write(pByte(data)^, size);
SubStream.Position := 0;
pCnt := Size div SizeOf(Integer);
for i := 0 to pCnt - 1 do
begin
SubStream.read(xInt, SizeOf(Integer));
FPointIDs[i] := Pointer(xInt);
end;
SubStream.Free;
end;
end;
//if Not Assigned(Self.FOnDelete) then
// GArchEngine.SetHandlersToObj(Self);
GArchEngine.AfterLoadProps(Self);
end;
//Tolik 04/04/2019 --
procedure TNet.WriteToStream(Stream: TStream);
var
xByte: Byte;
xInt: Integer;
xDbl: Double;
i: Integer;
p: TDoublePoint;
path: TnetPath;
Struct: TNetStruct;
aPoints: Pointer;
SubStream: TMemoryStream;
begin
inherited;
xInt := Round(MapScale);
WriteField(20, Stream, xInt, 4);
//xInt := Round(FID);
//WriteField(21, Stream, xInt, 4);
xInt := Round(FComponID);
WriteField(21, Stream, xInt, 4);
xDbl := WallThick;
WriteField(220, Stream, xDbl, 8);
xByte := Byte(FillWalls);
WriteField(92, Stream, xByte, 1);
xByte := Byte(WorldDim);
WriteField(93, Stream, xByte, 1);
// MapScale
xDbl := MapScale;
WriteField(239, Stream, xDbl, sizeof(xDbl));
//Tolik 07/12/2021 == òóò ïðîñòî ñáðîñèì çàïèñü â ñòðèì, åñëè íåò òî÷åê (åñëè íåò òî÷åê - ïóòè òîæå íåõ ïèñàòü, ò.ê.
// íåò îñíîâàíèÿ èõ ñòðîèòü)
if Points.Count > 0 then
begin
//
// write points
GetMem(aPoints, Points.Count * 16);
for i := 0 to Points.Count - 1 do
begin
p := PDoublePoint(Points[i])^;
pDouble(PAnsiChar(aPoints) + ((i) * 16) + 0)^ := p.x;
pDouble(PAnsiChar(aPoints) + ((i) * 16) + 8)^ := p.y;
end;
WriteBinField(150, Stream, pByte(aPoints), Points.Count * 16);
FreeMem(aPoints, Points.Count * 16);
// write paths
SubStream := TMemoryStream.Create;
SubStream.Write(Paths.Count, 4);
for i := 0 to Paths.Count - 1 do
begin
path := TNetpath(paths[i]);
path.WriteToStream(SubStream);
end;
WriteStreamField(151, Stream, SubStream);
SubStream.Free;
end;
// write structs
SubStream := TMemoryStream.Create;
SubStream.Write(Structs.Count, 4);
for i := 0 to Structs.Count - 1 do
begin
Struct := TNetStruct(Structs[i]);
Struct.WriteToStream(SubStream);
end;
WriteStreamField(152, Stream, SubStream);
SubStream.Free;
// write point ids //#From Oleg# //04.10.2010
GetMem(aPoints, FPointIDs.Count * SizeOf(Integer));
For i := 0 to FPointIDs.Count - 1 do
Integer(Pointer(PAnsiChar(aPoints) + (i*SizeOf(Integer)) )^ ) := Integer(FPointIDs[i]);
WriteBinField(153, Stream, pByte(aPoints), FPointIDs.Count * SizeOf(Integer));
FreeMem(aPoints, FPointIDs.Count * SizeOf(Integer));
end;
(*
procedure TNet.WriteToStream(Stream: TStream);
var
xByte: Byte;
xInt: Integer;
xDbl: Double;
i: Integer;
p: TDoublePoint;
path: TnetPath;
Struct: TNetStruct;
aPoints: Pointer;
SubStream,fStream: TMemoryStream;
size:Integer;
begin
inherited;
xInt := Round(MapScale);
WriteField(20, Stream, xInt, 4);
//xInt := Round(FID);
//WriteField(21, Stream, xInt, 4);
xInt := Round(FComponID);
WriteField(21, Stream, xInt, 4);
xDbl := WallThick;
WriteField(220, Stream, xDbl, 8);
xByte := Byte(FillWalls);
WriteField(92, Stream, xByte, 1);
xByte := Byte(WorldDim);
WriteField(93, Stream, xByte, 1);
// MapScale
xDbl := MapScale;
WriteField(239, Stream, xDbl, sizeof(xDbl));
// write points
GetMem(aPoints, Points.Count * 16);
For i := 0 to Points.Count - 1 do
begin
p := PDoublePoint(Points[i])^;
pDouble(pChar(aPoints) + ((i) * 16) + 0)^ := p.x;
pDouble(pChar(aPoints) + ((i) * 16) + 8)^ := p.y;
end;
WriteBinField(150, Stream, pByte(aPoints), Points.Count * 16);
FreeMem(aPoints, Points.Count * 16);
// write paths
SubStream := TMemoryStream.Create;
SubStream.Write(Paths.Count, 4);
for i := 0 to Paths.Count - 1 do
begin
path := TNetpath(paths[i]);
path.WriteToStream(SubStream);
end;
WriteStreamField(151, Stream, SubStream);
SubStream.Free;
// write structs
SubStream := TMemoryStream.Create;
SubStream.Write(Structs.Count, 4);
for i := 0 to Structs.Count - 1 do
begin
Struct := TNetStruct(Structs[i]);
Struct.WriteToStream(SubStream);
end;
WriteStreamField(152, Stream, SubStream);
SubStream.Free;
// write point ids //#From Oleg# //04.10.2010
GetMem(aPoints, FPointIDs.Count * SizeOf(Integer));
For i := 0 to FPointIDs.Count - 1 do
Integer(Pointer(pChar(aPoints) + (i*SizeOf(Integer)) )^ ) := Integer(FPointIDs[i]);
WriteBinField(153, Stream, pByte(aPoints), FPointIDs.Count * SizeOf(Integer));
FreeMem(aPoints, FPointIDs.Count * SizeOf(Integer));
end;
*)
procedure TNet.ClearNetPoints;
var
i: Integer;
p: PDoublePOint;
begin
try
for i := 0 to Points.Count - 1 do
begin
p := PDoublePoint(Points[i]);
Dispose(p);
end;
Points.Clear;
except
// ShowMessage(CPowerCadMessage + 'TNet.ClearNetPoints');
end;
end;
procedure TNet.ClearPaths;
var
i: Integer;
p: TNetPath;
begin
try
for i := 0 to Paths.Count - 1 do
begin
p := TNetPath(Paths[i]);
p.free;
end;
except
// ShowMessage(CPowerCadMessage + 'TNet.ClearPaths');
end;
end;
procedure TNet.ClearStructs;
var
i: Integer;
S: TNetStruct;
begin
try
for i := 0 to Structs.Count - 1 do
begin
s := TNetStruct(Structs[i]);
s.free;
end;
except
// ShowMessage(CPowerCadMessage + 'TNet.ClearStructs');
end;
end;
procedure TNet.drawline(DEngine:TPCDrawEngine;p1, p2: TDoublePoint; Color, Width: Integer;
Style: TPenStyle);
var
z: Double;
tp1,tp2,bp1,bp2: TDoublePoint;
begin
DEngine.drawline(p1, p2, Color, Width, ord(style), 0);
end;
procedure TNet.MarkBrokenPaths;
var
xPath: TNetPath;
brDone: Boolean;
xPaths: TList;
i: Integer;
begin
xPaths:= TList.Create;
for i := 0 to Paths.Count-1 do
begin
xPaths.Add(Paths[i]);
TNetPath(Paths[i]).Broken := False;
end;
brDone := false;
repeat
xPath := FindBrokenPath(xPaths);
if assigned(xPath) then
begin
xPath.Broken := True;
xPaths.Remove(xPath);
end
else
begin
brDone := true;
end;
until brDone;
xPaths.Free;
end;
function TNet.CountIntersectingPathsOfKnot(p: PDoublePoint;
lPaths: Tlist): Integer;
var
i,cnt: Integer;
path: TnetPath;
begin
result := 0;
cnt := 0;
for i := 0 to lPaths.Count - 1 do
begin
path := TnetPath(lPaths[i]);
if (path.isKnotIn(p) > 0) then
begin
cnt := cnt + 1;
end;
end;
result := cnt;
end;
function TNet.SnapPoints(var x, y: Double; DotsPerMil: Double): Boolean;
var
dx,dy,d: Double;
i: Integer;
path: TnetPath;
struct: TnetStruct;
fig: String;
sx,sy: Double;
begin
result := false;
fig := TPowerCad(Owner).SnapInfo;
if (fig = 'TPipeLine') or (Fig = 'TPipe') or (Fig = 'TCircleVertex') or
(Fig = 'TLine') or (Fig = 'TCanliHat') or (Fig = 'TDikmeHat') then
begin
result := False;
sx := x;
sy := y;
FindClosestSnap(sx,sy);
d:= GetLineLength(DoublePoint(sx,sy),DoublePoint(x,y));
if ((d * DotsPerMil) <= 24) and (d <> 0) then
begin
result := true;
x := sx;
y := sy;
end;
end
else
if (fig = 'TWallPath') or (fig = 'TWallRect') or (fig = 'TInsertCol') or (fig = 'TInsertRow') then
begin
result := SnapToKnots(x,y,DotsPerMil,True);
end
else
if (fig = 'TMirror') or (TPowerCad(Owner).ToolInfo = 'TMirror') or (assigned(TPowerCad(Owner).TraceFigure) and
(TPowerCad(Owner).TraceFigure.Cname = 'TMirror')) then
begin
result := SnapToKnots(x,y,DotsPerMil,False);
end
else
if (fig = 'TRoundStairs') or (fig = 'TSimpleStairs') or (fig = 'TRectangle') or (fig = 'TFloor') then
begin
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(Paths[i]);
if path.SnapToCorners(x,y,DotsPerMil) then
begin
result := true;
exit;
end;
end;
end;
end;
procedure TNet.IntersectPipeCorner(pIndex: Integer);
var
path: TnetPath;
p1,p2: TDoublePoint;
p3,p4: TDoublePoint;
xPaths: TList;
p: PDoublePoint;
id,i,k,cnt,icnt: Integer;
path1,path2: TnetPath;
ip,ip1,ip2: TDoublePOint;
intersect: Boolean;
closed: Boolean;
lPath: TnetPath;
r1,r2,radius: Double;
HasWall: Boolean;
HasGlass: Boolean;
j1,j2: TDoublePOint;
flat: Boolean;
begin
p := pDoublePoint(points[pIndex]);
xPaths := TList.Create;
cnt := 0;
HasWall:= False;
HasGlass := False;
lPath := nil; //#From Oleg# //14.09.2010
for i := 0 to Paths.Count -1 do
begin
path := TNetPath(Paths[i]);
closed:= path.Isclosed;
id := path.isKnotValIn(p^);
if (id > 0) and (not Closed) then
begin
if path.WType in [wtWall,wtOpen,wtGlass,wtHalf] then
begin
if Path.WType in [wtWall,wtOpen] then
hasWall := True
else
HasGlass := True;
cnt := cnt+1;
xPaths.Add(path);
if id = 1 then
path.Angle := GetRadOfLine(p^,path.p2^)
else
path.Angle := GetRadOfLine(p^,path.p1^);
path.Dir := id;
lPath := path;
end;
end;
end;
cnt := xPaths.Count;
if haswall and hasGlass then
begin
for i := cnt-1 downto 0 do
if TnetPath(xPaths[i]).WType in [wtGlass,wtHalf] then
xPaths.Remove(xPaths[i]);
end;
cnt := xPaths.Count;
if cnt = 1 then
begin
if lpath.dir = 1 then
begin
lpath.Empty1 := true;
if not lPath.isArc then
begin
lPath.Hl1 := MPoint(lPath.Hl1,lPath.Hl2,-((lpath.Width/2)+1));
lPath.Hr1 := MPoint(lPath.Hr1,lPath.Hr2,-((lpath.Width/2)+1));
end;
end
else
begin
lpath.Empty2 := true;
if not lPath.isArc then
begin
lPath.HL2 := MPoint(lPath.Hl2,lPath.Hl1,-((lpath.Width/2)+1));
lPath.HR2 := MPoint(lPath.Hr2,lPath.Hr1,-((lpath.Width/2)+1));
end;
end;
end;
if xPaths.Count < 2 then
//Tolik 07/02/2017 --
// exit;
begin
FreeAndNil(xPaths);
exit;
end;
//
SortPathAngles(xPaths,0,xPaths.Count-1);
for i := 0 to xPaths.Count-1 do
begin
path1 := TNetPath(xPaths[i]);
if i < xPaths.Count-1 then
k := i+1
else
k := 0;
path2 := TNetPath(xPaths[k]);
intersect := true;
if Intersect then
begin
if (not path1.isArc) and (not path2.isArc) then
begin
if path1.Dir = 1 then
begin
p1 := path1.Hr1; p2 := path1.Hr2;
end
else
begin
p1 := path1.Hl1; p2 := path1.Hl2;
end;
if path2.Dir = 2 then
begin
p3 := path2.Hr1; p4 := path2.Hr2;
end
else
begin
p3 := path2.Hl1; p4 := path2.Hl2;
end;
if GetIntersectionPoint(p1,p2,p3,p4,ip) then
begin
flat := EQDP(ip,p1) or EQDP(p2,ip);
if path1.Dir = 1 then
begin
if flat then
path1.HR1 := MPoint(path1.HR1,path1.HR2,((path1.Width/2)+1))
else
path1.Hr1 := ip;
end
else
begin
if flat then
path1.Hl2 := MPoint(path1.Hl2,path1.Hl1,((path1.Width/2)+1))
else
path1.Hl2 := ip;
end;
if path2.Dir = 1 then
begin
if flat then
path2.HL1 := MPoint(path2.HL1,path2.HL2,((path2.Width/2)+1))
else
path2.Hl1 := ip
end
else
begin
if flat then
path2.Hr2 := MPoint(path2.Hr2,path2.Hr1,((path2.Width/2)+1))
else
path2.Hr2 := ip;
end;
end;
end
else
if (path1.isArc) and (not path2.isArc) then
begin
if path1.Dir = 1 then
begin
p1 := path1.Hr2; p2 := path1.Hr1;
end
else
begin
p1 := path1.Hl1; p2 := path1.Hl2;
end;
if path2.Dir = 2 then
begin
p3 := path2.Hr1; p4 := path2.Hr2;
end
else
begin
p3 := path2.Hl2; p4 := path2.Hl1;
end;
radius := GetLineLenght(p1,path1.ArcCenter);
if GetLineCircleIntersection(p3,p4,path1.ArcCenter,radius,ip1,ip2,iCnt) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(p4,ip1,ip2);
if path1.Dir = 1 then
begin
path1.Hr1 := ip;
//path1.ArcJoinB1 := ip;
//path1.ArcJoinB1L := ip;
end
else
begin
path1.Hl2 := ip;
//path1.ArcJoinA2 := ip;
//path1.ArcJoinA2L := ip;
end;
if path2.Dir = 1 then
path2.Hl1 := ip
else
path2.Hr2 := ip;
end
else
begin
if (path1.Dir = 1) then
j1 := path1.Hr1
else
j1 := path1.Hl2;
if path2.Dir = 1 then
j2 := path2.Hl1
else
j2 := path2.Hr2;
if path1.Dir = 1 then
begin
//path1.ArcJoinB1 := j1;
//path1.ArcJoinB1L := j2;
end
else
begin
//path1.ArcJoinA2 := j1;
//path1.ArcJoinA2L := j2;
end;
end;
end
else
if (not path1.isArc) and (path2.isArc) then
begin
if path1.Dir = 1 then
begin
p1 := path1.Hr2; p2 := path1.Hr1;
end
else
begin
p1 := path1.Hl1; p2 := path1.Hl2;
end;
if path2.Dir = 2 then
begin
p3 := path2.Hr1; p4 := path2.Hr2;
end
else
begin
p3 := path2.Hl2; p4 := path2.Hl1;
end;
radius := GetLineLenght(p3,path2.ArcCenter);
if GetLineCircleIntersection(p1,p2,path2.ArcCenter,radius,ip1,ip2,iCnt) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(p2,ip1,ip2);
if path1.Dir = 1 then
path1.Hr1 := ip
else
path1.Hl2 := ip;
if path2.Dir = 1 then
begin
path2.Hl1 := ip;
//path2.ArcJoinA1 := ip;
//path2.ArcJoinA1L := ip;
end
else
begin
path2.Hr2 := ip;
//path2.ArcJoinB2 := ip;
//path2.ArcJoinB2L := ip;
end;
end
else
begin
if path1.Dir = 1 then
j1 := path1.Hr1
else
j1 := path1.Hl2;
if (path2.Dir = 1) then
j2 := path2.Hl1
else
j2 := path2.Hr2;
if path2.Dir = 1 then
begin
//path2.ArcJoinA1 := j1;
//path2.ArcJoinA1L := j2;
end
else
begin
//path2.ArcJoinB2 := j1;
//path2.ArcJoinB2L := j2;
end;
end;
end
else
if ( path1.isArc) and (path2.isArc) then
begin
if path1.Dir = 1 then
begin
p1 := path1.Hr2; p2 := path1.Hr1;
end
else
begin
p1 := path1.Hl1; p2 := path1.Hl2;
end;
if path2.Dir = 2 then
begin
p3 := path2.Hr1; p4 := path2.Hr2;
end
else
begin
p3 := path2.Hl2; p4 := path2.Hl1;
end;
r1 := GetLineLenght(p1,path1.ArcCenter);
r2 := GetLineLenght(p3,path2.ArcCenter);
if GetCircleCircleIntersection(path1.ArcCenter,r1,path2.ArcCenter,r2,ip1,ip2,iCnt) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(p2,ip1,ip2);
if path1.Dir = 1 then
begin
path1.Hr1 := ip;
//path1.ArcJoinB1 := ip;
//path1.ArcJoinB1L := ip;
end
else
begin
path1.Hl2 := ip;
//path1.ArcJoinA2 := ip;
//path1.ArcJoinA2L := ip;
end;
if path2.Dir = 1 then
begin
path2.Hl1 := ip;
//path2.ArcJoinA1 := ip;
//path2.ArcJoinA1L := ip;
end
else
begin
path2.Hr2 := ip;
//path2.ArcJoinB2 := ip;
//path2.ArcJoinB2L := ip;
end;
end
else
begin
if path1.Dir = 1 then
j1 := path1.Hr1
else
j1 := path1.Hl2;
if (path2.Dir = 1) then
j2 := path2.Hl1
else
j2 := path2.Hr2;
if path1.Dir = 1 then
begin
//path1.ArcJoinB1 := j1;
//path1.ArcJoinB1L := j2;
end
else
begin
//path1.ArcJoinA2 := j1;
//path1.ArcJoinA2L := j2;
end;
if path2.Dir = 1 then
begin
//path2.ArcJoinA1 := j1;
//path2.ArcJoinA1L := j2;
end
else
begin
//path2.ArcJoinB2 := j1;
//path2.ArcJoinB2L := j2;
end;
end;
end;
end;
end;
//Tolik -- 07/02/2017 --
FreeAndNil(xPaths);
//
end;
Function TNet.CreatePaths(pArr: TDoublePointArr; dontRefresh: Boolean): TNetPath;
var
i, k: Integer;
pa, pb: PDoublePoint;
path: TnetPath;
p1, p2, p: TDoublePoint;
cnt, pCnt: Integer;
pGrp: TDoublePointGroup;
gCnt: Integer;
gArr: TDoublePointArr;
dx, dy: Double;
Polly: TDoublePointArr;
PathOnKnotA, PathOnKnotB, PathOnKnot: TNetPath; //02.04.2013
//Tolik 07/12/2021 --
function CheckIsOnePoint(a,b: PDoublePoint): Boolean;
begin
Result := ((CompareValue(a^.x, b^.x, 0.05) = 0) and (CompareValue(a^.y, b^.y, 0.05) = 0));
end;
//
begin
result := nil;
cnt := Length(pArr);
if cnt < 2 then
exit;
if CheckLineOnLine(pArr) then
exit;
if not CheckSelfIntersection(pArr) then
exit;
if not GroupPathPointsByIntersection(pArr, pGrp) then
exit;
//SetLength(pGrp, 1);
//pGrp[0] := pArr;
if Length(pGrp) > 0 then
begin
//SetLength(Polly, .);
end;
cnt := Length(pArr);
gCnt := Length(pGrp);
pCnt := 0;
for i := 0 to gCnt - 1 do
begin
gArr := pGrp[i];
cnt := Length(gArr);
for k := 0 to cnt - 2 do
begin
p1 := gArr[k];
p2 := gArr[k + 1];
if not EQDP(p1, p2) then //if Not CmpDP(@p1, @p2) then //18.02.2011 if not EQDP(p1, p2) then
begin
PathOnKnotA := nil; //02.04.2013
PathOnKnotB := nil; //02.04.2013
pa := InsertKnot(p1, true, @PathOnKnotA);
// Tolik 17/10/2016--
//pb := InsertKnot(p2, true, @PathOnKnotB);
pb := InsertKnot(p2, true, @PathOnKnotB, pa);
//
if assigned(pa) and assigned(pb) then
begin
if FAllowAddPathWithSamePoints or (pa <> pb) then
begin
//Tolik 07/12/2021 --
if not CheckIsOnePoint(pa,pb) then
begin
//
path := AddPath(pa, pb, false);
if assigned(path) then
begin
PathOnKnot := PathOnKnotA;
if PathOnKnot = nil then
PathOnKnot := PathOnKnotB;
if PathOnKnot <> nil then
begin
path.wstyle := PathOnKnot.wstyle;
path.FColor := PathOnKnot.FColor;
path.FBrushColor := PathOnKnot.FBrushColor;
path.FBrushStyle := PathOnKnot.FBrushStyle;
end;
pCnt := pCnt + 1;
if pcnt = 1 then
result := path;
end;
end;
end;
end;
end;
end;
end;
//if pCnt > 1 then result := nil;
if not DontRefresh then
RefreshPaths;
end;
procedure TNet.GetCornerPatch(pIndex:Integer; var pArr: TdoublePointArr);
var
path: TnetPath;
p1,p2: TDoublePoint;
p3,p4: TDoublePoint;
xPaths: TList;
p: PDoublePoint;
id,i,k,cnt,icnt: Integer;
path1,path2: TnetPath;
ip,ip1,ip2: TDoublePOint;
intersect: Boolean;
closed: Boolean;
lPath: TnetPath;
r1,r2,radius: Double;
HasWall: Boolean;
HasGlass: Boolean;
j1,j2: TDoublePOint;
begin
SetLength(pArr,0);
p := pDoublePoint(points[pIndex]);
for i := 0 to Structs.Count -1 do
begin
if (TnetStruct(Structs[i]) is TNetCol) and (TNetCol(Structs[i]).p1 = p) then
exit;
end;
xPaths := TList.Create;
cnt := 0;
HasWall:= False;
HasGlass := False;
for i := 0 to Paths.Count -1 do
begin
path := TNetPath(Paths[i]);
closed:= path.Isclosed;
id := path.isKnotValIn(p^);
if (id > 0) and (not Closed) then
begin
if path.WType in [wtWall,wtOpen,wtGlass,wtHalf] then
begin
if Path.WType in [wtWall,wtOpen] then
hasWall := True
else
HasGlass := True;
cnt := cnt+1;
xPaths.Add(path);
if id = 1 then
path.Angle := GetRadOfLine(p^,path.p2^)
else
path.Angle := GetRadOfLine(p^,path.p1^);
path.Dir := id;
lPath := path;
end;
end;
end;
cnt := xPaths.Count;
if haswall and hasGlass then
begin
for i := cnt-1 downto 0 do
if TnetPath(xPaths[i]).WType in [wtGlass,wtHalf] then
xPaths.Remove(xPaths[i]);
end;
cnt := xPaths.Count;
if xPaths.Count < 3 then
//Tolik 07/02/2017 --
// exit;
begin
FreeAndNil(xPaths);
exit;
end;
//
SortPathAngles(xPaths,0,xPaths.Count-1);
SetLength(pArr,xPaths.Count);
for i := 0 to xPaths.Count-1 do
begin
path1 := TNetPath(xPaths[i]);
if i < xPaths.Count-1 then
k := i + 1
else
k := 0;
path2 := TNetPath(xPaths[k]);
intersect := true;
if Intersect then
begin
if (not path1.isArc) and (not path2.isArc) then
begin
if path1.Dir = 1 then
begin
p1 := path1.r1; p2 := path1.r2;
end
else
begin
p1 := path1.l1; p2 := path1.l2;
end;
if path2.Dir = 2 then
begin
p3 := path2.r1; p4 := path2.r2;
end
else
begin
p3 := path2.l1; p4 := path2.l2;
end;
GetIntersectionPoint(p1,p2,p3,p4,ip);
pArr[i] := ip;
end
else
if (path1.isArc) and (not path2.isArc) then
begin
if path1.Dir = 1 then
begin
p1 := path1.r2; p2 := path1.r1;
end
else
begin
p1 := path1.l1; p2 := path1.l2;
end;
if path2.Dir = 2 then
begin
p3 := path2.r1; p4 := path2.r2;
end
else
begin
p3 := path2.l2; p4 := path2.l1;
end;
radius := GetLineLenght(p1,path1.ArcCenter);
if GetLineCircleIntersection(p3,p4,path1.ArcCenter,radius,ip1,ip2,iCnt) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(p4,ip1,ip2);
pArr[i] := ip;
end
else
begin
if (path1.Dir = 1) then
j1 := path1.r1
else
j1 := path1.l2;
pArr[i] := j1;
end;
end
else
if (not path1.isArc) and (path2.isArc) then
begin
if path1.Dir = 1 then
begin
p1 := path1.r2; p2 := path1.r1;
end
else
begin
p1 := path1.l1; p2 := path1.l2;
end;
if path2.Dir = 2 then
begin
p3 := path2.r1; p4 := path2.r2;
end
else
begin
p3 := path2.l2; p4 := path2.l1;
end;
radius := GetLineLenght(p3,path2.ArcCenter);
if GetLineCircleIntersection(p1,p2,path2.ArcCenter,radius,ip1,ip2,iCnt) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(p2,ip1,ip2);
pArr[i] := ip;
end
else
begin
if path1.Dir = 1 then
j1 := path1.r1
else
j1 := path1.l2;
pArr[i] := j1;
end;
end
else
if ( path1.isArc) and (path2.isArc) then
begin
if path1.Dir = 1 then
begin
p1 := path1.r2; p2 := path1.r1;
end
else
begin
p1 := path1.l1; p2 := path1.l2;
end;
if path2.Dir = 2 then
begin
p3 := path2.r1; p4 := path2.r2;
end
else
begin
p3 := path2.l2; p4 := path2.l1;
end;
r1 := GetLineLenght(p1,path1.ArcCenter);
r2 := GetLineLenght(p3,path2.ArcCenter);
if GetCircleCircleIntersection(path1.ArcCenter,r1,path2.ArcCenter,r2,ip1,ip2,iCnt) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(p2,ip1,ip2);
pArr[i] := ip;
end
else
begin
if path1.Dir = 1 then
j1 := path1.r1
else
j1 := path1.l2;
pArr[i] := j1;
end;
end;
end;
end;
// Tolik 07/02/2017 --
FreeAndNil(xPaths);
//
end;
procedure TNet.IntersectColCorner(pIndex: Integer);
var
path: TnetPath;
col: TnetCol;
p1,p2: TDoublePoint;
p3,p4: TDoublePoint;
xPaths: TList;
p: PDoublePoint;
id,i,k,cnt,icnt: Integer;
path1,path2: TnetPath;
ip,ip1,ip2: TDoublePOint;
intersect: Boolean;
closed: Boolean;
lPath: TnetPath;
r1,r2,radius: Double;
HasWall: Boolean;
HasGlass: Boolean;
j1,j2: TDoublePOint;
ap1,ap2,ap3,ap4: TdoublePoint;
begin
p := pDoublePoint(points[pIndex]);
Col := GetKnotCol(p);
if not assigned(col) then
exit;
Col.GetPoints(ap1,ap2,ap3,ap4);
xPaths := TList.Create;
cnt := 0;
HasWall:= False;
HasGlass := False;
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(Paths[i]);
closed:= path.Isclosed;
id := path.isKnotValIn(p^);
if (id > 0) and (not Closed) then
begin
if path.WType in [wtWall,wtOpen,wtGlass,wtHalf] then
begin
if Path.WType in [wtWall,wtOpen] then
hasWall := True
else
HasGlass := True;
cnt := cnt + 1;
xPaths.Add(path);
if id = 1 then
path.Angle := GetRadOfLine(p^,path.p2^)
else
path.Angle := GetRadOfLine(p^,path.p1^);
path.Dir := id;
lPath := path;
end;
end;
end;
cnt := xPaths.Count;
if haswall and hasGlass then
begin
for i := cnt - 1 downto 0 do
if TnetPath(xPaths[i]).WType in [wtGlass,wtHalf] then
xPaths.Remove(xPaths[i]);
end;
cnt := xPaths.Count;
for i := 0 to xPaths.Count - 1 do
begin
lPath := TNetPath(xPaths[i]);
Col.IntersectPath(lPath);
end;
end;
function TNet.GetKnotCol(p: PdoublePoint): TnetCol;
var
i: Integer;
begin
result:= nil;
for i := 0 to Structs.Count - 1 do
begin
if TnetStruct(Structs[i]) is TnetCol then
begin
if TnetCol(Structs[i]).p1 = p then
begin
result := TnetCol(Structs[i]);
exit;
end;
end;
end;
end;
procedure TNet.IntersectColPipeCorner(pIndex: Integer);
var
path: TnetPath;
col: TnetCol;
row: TNetRow;
p1,p2: TDoublePoint;
p3,p4: TDoublePoint;
xPaths: TList;
p: PDoublePoint;
id,i,k,cnt,icnt: Integer;
path1,path2: TnetPath;
ip,ip1,ip2: TDoublePOint;
intersect: Boolean;
closed: Boolean;
lPath: TnetPath;
r1,r2,radius: Double;
HasWall: Boolean;
HasGlass: Boolean;
j1,j2: TDoublePOint;
begin
p := pDoublePoint(points[pIndex]);
xPaths := TList.Create;
cnt := 0;
HasWall:= False;
HasGlass := False;
for i := 0 to Paths.Count -1 do
begin
path := TNetPath(Paths[i]);
closed:= path.Isclosed;
id := path.isKnotValIn(p^);
if (id > 0) and (not Closed) then
begin
if path.WType in [wtWall,wtOpen,wtGlass,wtHalf] then
begin
if Path.WType in [wtWall,wtOpen] then
hasWall := True
else
HasGlass := True;
cnt := cnt + 1;
xPaths.Add(path);
if id = 1 then
path.Angle := GetRadOfLine(p^,path.p2^)
else
path.Angle := GetRadOfLine(p^,path.p1^);
path.Dir := id;
lPath := path;
end;
end;
end;
cnt := xPaths.Count;
if haswall and hasGlass then
begin
for i := cnt - 1 downto 0 do
if TnetPath(xPaths[i]).WType in [wtGlass,wtHalf] then
xPaths.Remove(xPaths[i]);
end;
cnt := xPaths.Count;
Col := GetKnotCol(p);
if assigned(col) then
begin
for i := 0 to xPaths.Count - 1 do
begin
lPath := TNetPath(xPaths[i]);
Col.IntersectPathPipe(lPath);
end;
end;
for k := 0 to Structs.Count - 1 do
begin
if TnetStruct(Structs[k]) is TNetRow then
begin
if (TnetRow(Structs[k]).p1 = p) or (TnetRow(Structs[k]).p2 = p) then
begin
for i := 0 to xPaths.Count-1 do
begin
lPath := TNetPath(xPaths[i]);
TnetRow(Structs[k]).IntersectPathPipe(lPath);
end;
end;
end;
end;
end;
procedure TNet.SnapModPoint(var x, y: Double; mp: TModPoint; traceNet: Tnet);
var
dx, dy: Double;
wt: Double;
l, d, minD, dist: Double;
path: TnetPath;
begin
minD := 100 / MapScale;
wt := WallThick;
dx := abs(mp.Coordx - x);
dy := abs(mp.Coordy - y);
if (mp.PType = ptPolyPoint) then
begin
if dx > dy then
dy := 0
else
dx := 0;
end
else
if ((mp.PType = ptRectPoint) or (mp.PType = ptGroupPoint)) and (mp.Tag > -1) and (mp.Tag < traceNet.Paths.Count) then
begin
Path := TnetPath(traceNet.Paths[mp.Tag]);
if Path.PosType = ptVertical then
dy := 0
else
dx := 0;
end;
if not Tpowercad(owner).SnapToNearPoint then
begin
if dx <> 0 then
y := mp.Coordy;
if dy <> 0 then
x := mp.Coordx;
exit;
end;
if dx <> 0 then
begin
d := dx;
d := d + wt;
l := Trunc(d / minD) * mind;
dist := d - l;
if dist >= (mind / 2) then
begin
l := l + MinD;
end;
l := l - wt;
if x > mp.Coordx then
x := mp.Coordx + l
else
x := mp.Coordx - l;
end
else
x := mp.Coordx;
if (dy <> 0) then
begin
d := dy;
d := d + wt;
l := Trunc(d / minD) * mind;
dist := d - l;
if dist >= (mind / 2) then
begin
l := l + MinD;
end;
l := l - wt;
if y > mp.CoordY then
y := mp.CoordY + l
else
y := mp.CoordY - l;
end
else
y := mp.CoordY;
end;
function TNet.PointOnPath(p: TDoublePoint): TNetPath;
var
i: Integer;
path: TnetPath;
begin
result := nil;
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(Paths[i]);
if (path.isPointIn(p.x,p.y)) then
begin
result := path;
exit;
end;
end;
end;
function TNet.FindCloserPath(p: TDoublePoint): TNetPath;
var
i: Integer;
d,dmin: Double;
path,pMin: TnetPath;
begin
result := nil;
dmin := -1;
pMin := nil;
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(paths[i]);
if (path.WType = wtWall) and not (path.isArc) then
begin
d := GetDistToLine(path.p1^,path.p2^,p);
if (dMin = -1) then
begin
dMin := d;
pMin := path;
end;
if d < dMin then
begin
dMin := d;
pMin := path;
end;
end;
end;
result := pMin;
end;
procedure TNet.NormalizeKnot(p: PDoublePoint; Net: Tnet);
var
xPaths: TList;
path: TnetPath;
px: PDoublePOint;
i: Integer;
dx, dy: Double;
begin
xPaths := TList.Create;
Net.GetPathsOfKnot(p, xPaths);
for i := 0 to xPaths.Count - 1 do
begin
path := TnetPath(xPaths[i]);
px := path.OtherPoint(p);
dx := abs(px^.x - p^.x);
dy := abs(px^.y - p^.y);
if (dx < 3) then
p^.x := px^.x;
if (dy < 3) then
p^.y := px^.y;
end;
end;
procedure TNet.InvertSelPathValue(val: Boolean);
var
index: Integer;
path: TNetPath;
begin
if SelIndex > 0 then
begin
index := SelIndex-1;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
if path.isArc then
begin
Path.inverted := val;
RefreshPaths;
end;
end;
end;
end;
procedure TNet.FindClosestSnap(var x, y: Double);
var
dx,dy: Double;
i: Integer;
path: TnetPath;
struct: TnetStruct;
fig: String;
ox,oy,sx,sy: Double;
dSnap,d: Double;
rFig:TFigure;
begin
if (Paths.Count = 0) and (Structs.Count=0) then
exit;
ox := x;
oy := y;
dSnap := -1234567;
sx := 0; //#From Oleg# //14.09.2010
sy := 0; //#From Oleg# //14.09.2010
for i := 0 to Structs.Count - 1 do
begin
x := ox;
y := oy;
Struct := TnetStruct(Structs[i]);
if Struct.SnapPoints(x,y,TPowercad(owner).DotsPerMil) then
begin
d := GetLineLenght(DoublePoint(ox,oy),DoublePoint(x,y));
dSnap := d;
sx := x;
sy := y;
end;
end;
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(Paths[i]);
x := ox;
y := oy;
if path.ForceSnapToPipeCorners(x,y,dSnap) then
begin
sx := x;
sy := y;
end;
end;
if (dSnap * TPowercad(owner).DotsPermil) < 24 then
begin
x := sx;
y := sy;
exit;
end;
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(Paths[i]);
x := ox;
y := oy;
if path.ForceSnapToPipeLine(x,y,dSnap) then
begin
sx := x;
sy := y;
end;
end;
x := sx;
y := sy;
end;
procedure TNet.SetWallKris(val: Boolean);
var
index: Integer;
path: TNetPath;
begin
if SelIndex > 0 then
begin
index := SelIndex - 1;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
Path.isRow := val;
RefreshPaths;
end;
end;
end;
procedure TNet.FillColSpaces;
begin
end;
function TNet.SelCenter: TDoublePoint;
var
index: Integer;
path: TnetPath;
Struct: TNetStruct;
begin
result := DoublePoint(0, 0);
index := SelIndex - 1;
if (SelType = stPath) and (SelIndex > 0) then
begin
if index < Paths.Count then
begin
path := TnetPath(Paths[Index]);
result := MPoint(path.p1^,path.p2^);
exit;
end;
end;
if (SelType = stStruct) and (SelIndex > 0) then
begin
if index < Structs.Count then
begin
struct := TNetStruct(Structs[Index]);
if Struct is TNetCol then
begin
result := TnetCol(Struct).p1^;
exit;
end
else
if Struct is TNetRow then
begin
result := Mpoint(TnetRow(Struct).p1^,TnetRow(Struct).p2^);
exit;
end;
end;
end;
Result := RectCenter(GetBoundRect);
end;
function TNet.SnapToKnots(var x, y: Double; DotsPerMil: Double;
SnapLine: Boolean): Boolean;
var
i: INteger;
path: TNetPath;
begin
result := false;
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(Paths[i]);
if path.SnapToKnots(x,y,DotsPerMil,SnapLine) then
begin
result := true;
exit;
end;
end;
end;
Function TNet.Edit: Boolean;
var
index: Integer;
enterstr: string;
Path: TnetPath;
begin
Result := False;
if selpath <> nil then
begin
//07.06.2010 - Çàïðåùàåì ðàçäåëåíèå ñòåí ïî äâ.êëèêó
if Self.FComponID = 0 then
begin
DivSelPath(DoublePoint(EditX,Edity));
Result := True;
end
else
begin
if selpath.DoorIndex <> -1 then
TNetDoor(selpath.Doors[selpath.DoorIndex]).DoDblClick
else
selpath.DoDblClick;
end;
end;
end;
procedure TNet.DrawFigureGuides(DEngine: TPCDrawEngine);
var
i: Integer;
begin
if (not DrawGuides) then
exit;
for i := 0 to Paths.Count - 1 do
begin
TnetPath(Paths[i]).DrawGuides(Dengine);
end;
for i := 0 to Structs.Count - 1 do
begin
TnetStruct(Structs[i]).DrawGuides(Dengine);
end;
end;
function TNet.FindMostSWPath(pathList: TList): TNetPath;
var
path: TnetPath;
mp:TDoublePOint;
ms,ds,mW,dw: Double;
i:Integer;
begin
result := nil;
if pathList.Count = 0 then
exit;
path := TnetPath(pathList[0]);
mp := MPoint(path.p1^,path.p2^);
mS := WorkHeight - mp.y;
mW := mp.x;
result := path;
for i := 1 to pathList.Count - 1 do
begin
path := TnetPath(pathList[i]);
mp := MPoint(path.p1^,path.p2^);
dS := WorkHeight - mp.y;
dW := mp.x;
if EQD(dS,mS) then
begin
if dw < mW then
begin
result := path;
mS := ds;
mW := dW;
end;
end
else
if dS < mS then
begin
result := path;
mS := ds;
mW := dW;
end;
end;
end;
function TNet.FindMostSEPath(pathList: TList): TNetPath;
var
path: TnetPath;
mp: TDoublePOint;
ms,ds,mE,dE: Double;
i: Integer;
begin
result := nil;
if pathList.Count = 0 then
exit;
path := TnetPath(pathList[0]);
mp := MPoint(path.p1^,path.p2^);
mS := WorkHeight - mp.y;
mE := mp.x;
for i := 1 to pathList.Count - 1 do
begin
path := TnetPath(pathList[i]);
mp := MPoint(path.p1^,path.p2^);
dS := WorkHeight - mp.y;
dE := mp.x;
if dS < mS then
begin
result := path;
mS := ds;
mE := dE;
end
else
if dS = mS then
begin
if dE > mE then
begin
result := path;
mS := ds;
mE := dE;
end;
end;
end;
end;
function TNet.SelPath: TnetPath;
begin
result := nil;
if (SelIndex > 0) and (selType = stPath) and (SelIndex <= Paths.Count) then
begin
result := TNetPath(Paths[SelIndex - 1]);
end;
end;
function TNet.SelPt: PDoublePoint;
begin
Result := nil;
if (FSelPtIdx <> -1) and (FSelPtIdx < Points.Count) then
Result := Points[FSelPtIdx];
end;
procedure TNet.DivSelPath;
var
index,i: Integer;
path: TNetPath;
mp:TdoublePoint;
xp,op:PDoublePoint;
begin
if (SelIndex > 0) and (selType = stPath) then
begin
index := SelIndex-1;
if assigned(undoProc) then
UndoProc;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
Path.BeforeDiv; //06.10.2010
try
mp := MPoint(path.p1^,path.p2^);
xp := InsertKnot(mp);
RefreshPaths;
finally
Path.AfterDiv; //06.10.2010
end;
end;
end;
end;
function TNet.SelDoor: TnetDoor;
var
path: TnetPath;
begin
result := nil;
path := SelPath;
if assigned(path) and (path.ActiveDoor <> nil) and (path.ActiveDoor.DoorObjType = dotDoor) then
begin
result := path.ActiveDoor;
end;
end;
function TNet.SelWindow: TnetDoor;
var
path:TnetPath;
begin
result := nil;
path := SelPath;
if assigned(path) and (path.ActiveDoor <> nil) and (path.ActiveDoor.DoorObjType = dotWindow) then
begin
result := path.ActiveDoor;
end;
end;
function TNet.SelCol: TnetCol;
begin
result := nil;
if (SelType = stStruct) and (SelIndex > 0) and (SelIndex <= Structs.Count) then
begin
if TNetStruct(Structs[SelIndex - 1]) is TNetCol then
result := Structs[SelIndex - 1];
end;
end;
function TNet.SelRow: TnetRow;
begin
result := nil;
if (SelType = stStruct) and (SelIndex > 0) and (SelIndex <= Structs.Count) then
begin
if TNetStruct(Structs[SelIndex - 1]) is TNetRow then
result := Structs[SelIndex - 1];
end;
end;
procedure TNet.AddNetCol;
var
index, i: Integer;
path: TNetPath;
begin
if (SelIndex > 0) and (selType = stPath) then
begin
index := SelIndex - 1;
if assigned(undoProc) then
UndoProc;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
Path.AddCols;
RefreshPaths;
end;
end;
end;
procedure TNet.AddCol;
begin
if SelPath <> nil then
begin
SelPath.AddCols;
RefreshPaths;
end;
end;
procedure TNet.LocatePathPoint(p: PDoublePoint; x, y: Double);
var
p1,p2: PDoublePOint;
pArr: TDoublePOintArr;
xPath: TNetPath;
SelPathWidth: Double;
begin
if SelPath = nil then
exit;
p1 := SelPath.OtherPoint(p);
SetLength(pArr, 2);
pArr[0] := DoublePoint(p1.x, p1.y);
pArr[1] := DoublePoint(x, y);
if SelPath <> nil then
SelPathWidth := SelPath.Width
else
SelPathWidth := -1;
if DeletePathSilent(SelPath) then
begin
xPath := MakePath(pArr, False);
if assigned(xPath) then
begin
//27.07.2011 SelType := stPath;
//27.07.2011 SelIndex := Paths.IndexOf(xPath) + 1;
SelectPath(Paths.IndexOf(xPath) + 1);
if SelPathWidth <> -1 then
begin
if xPath.Width <> SelPathWidth then
begin
xPath.Width := SelPathWidth;
RefreshPaths;
end;
end;
end;
end
else
begin
LocatePoint(p,x,y);
end;
end;
procedure TNet.DoublePath(path: TNetPath; delta: Double);
var
p1,p2: TDoublePoint;
pArr: TDoublePOintArr;
xPath: TNetPath;
dx,dy: Double;
begin
dx := abs(path.p1^.x - path.p2^.x);
dy := abs(path.p1^.y - path.p2^.y);
if dx > dy then
begin
delta := -delta;
p1 := MovePoint(path.p1^,0,delta);
p2 := MovePoint(path.p2^,0,delta);
end
else
begin
p1 := MovePoint(path.p1^,delta,0);
p2 := MovePoint(path.p2^,delta,0);
end;
SetLength(pArr,2);
pArr[0] := p1;
pArr[1] := p2;
xPath := MakePath(pArr,False);
if assigned(xPath) then
begin
//27.07.2011 SelType := stPath;
//27.07.2011 SelIndex := Paths.IndexOf(xPath) + 1;
SelectPath(Paths.IndexOf(xPath) + 1);
end;
end;
procedure TNet.LocatePath(path: TNetPath; delta: Double;delOld,repair:Boolean);
var
p1,p2,op1,op2,xp1,xp2: TDoublePoint;
o1,o2: PDoublePoint;
pArr: TDoublePOintArr;
xPath,aPath: TNetPath;
dx,dy: Double;
xUndo: TUndoProc;
list: TList;
i: INteger;
xEq,yEq: Boolean;
label ex;
begin
dx := abs(path.p1^.x - path.p2^.x);
dy := abs(path.p1^.y - path.p2^.y);
op1 := path.p1^;
op2 := path.p2^;
o1 := path.p1;
o2 := path.p2;
if dx > dy then
begin
delta := -delta;
p1 := MovePoint(path.p1^,0,delta);
p2 := MovePoint(path.p2^,0,delta);
end
else
begin
p1 := MovePoint(path.p1^,delta,0);
p2 := MovePoint(path.p2^,delta,0);
end;
SetLength(pArr,2);
xEq := EQD(p1.x, p2.x);
yEq := EQD(p1.y, p2.y);
xp1 := p1;
xp2 := p2;
Self.SnapToKnots(xp1.x,xp1.y,8,False);
if xEq then
xp2.x := xp1.x;
if yEq then
xp2.y := xp1.y;
Self.SnapToKnots(xp2.x,xp2.y,8,False);
if xEq then
xp1.x := xp2.x;
if yEq then
xp1.y := xp2.y;
pArr[0] := xp1;
pArr[1] := xp2;
xUndo := UndoProc;
UndoProc := nil;
xPath := nil; //#From Oleg# //14.09.2010
try
xPath := MakePath(pArr,False);
except
end;
if not assigned(xPath) then
goto ex;
try
if assigned(xPath) and repair then
begin
if xPath.Empty1 then
begin
pArr[0] := op1;
pArr[1] := xpath.p1^;
aPath := MakePath(pArr,False);
end;
if xPath.Empty2 then
begin
pArr[0] := op2;
pArr[1] := xpath.p2^;
aPath := MakePath(pArr,False);
end;
end;
if (paths.IndexOf(path) = -1) then
begin
path := nil;
path := Self.FindPathOfPoints(op1,op2);
end;
if assigned(path) and assigned(xPath) then
begin
xpath.CopyFrom(path);
end;
try
if delOld and (paths.IndexOf(path) <> -1) then
begin
DeletePath(path)
end
else
begin
path := Self.FindPathOfPoints(op1,op2);
if delOld and (assigned(path)) then
DeletePath(path);
end;
except
end;
if assigned(xPath) and repair and delOld then
begin
list := TList.Create;
if Self.Points.IndexOf(o1) > -1 then
Self.GetPathsOfKnot(o1,list);
if list.Count = 1 then
begin
aPath := TnetPath(list[0]);
DeletePath(aPath);
end;
list.Clear;
if Self.Points.IndexOf(o2) > -1 then
Self.GetPathsOfKnot(o2,list);
if list.Count = 1 then
begin
aPath := TnetPath(list[0]);
DeletePath(aPath);
end;
list.Free;
end;
except
end;
ex:
UndoProc := xUndo;
try
RefreshPaths;
except
end;
try
if assigned(xPath) then
begin
//27.07.2011 SelType := stPath;
//27.07.2011 SelIndex := Paths.IndexOf(xPath) + 1;
SelectPath(Paths.IndexOf(xPath) + 1);
end;
except
end;
end;
procedure TNet.LocateSelPath(Delta: Double;delOld,repair:Boolean);
begin
if selpath = nil then
exit;
Locatepath(SelPath,delta,delOld,repair);
end;
procedure TNet.DoubleSelPath(Delta: Double);
begin
if selpath = nil then
exit;
Doublepath(SelPath,delta);
end;
procedure TNet.MoveSatih(rpath: TNetPath; dx, dy: Double; control: Boolean);
var
xPaths,fPaths:Tlist;
rad,pRad: Double;
lPath,path:TnetPath;
i: Integer;
p1: PDoublePoint;
found:Boolean;
pList: TList;
valid:Boolean;
dAngle : Double;
dif: Double;
height1,height2: Double;
PointID1,POintID2: integer;
begin
rad := GetRadOfLine(rpath.p1^,rpath.p2^);
xPaths := TList.Create;
fPaths := Tlist.Create;
lPath := rpath;
p1 := rpath.p1;
repeat
xPaths.Clear;
GetPathsOfKnot(p1,xPaths);
xPaths.Remove(lPath);
found := false;
for i := 0 to xPaths.Count - 1 do
begin
path := TNetPath(xPaths[i]);
if rpath.Net.FSRCNet <> nil then
begin
PointID1 := Integer(rpath.Net.FSRCNet.FPointIDs[rpath.Net.Points.IndexOf(path.p1)]);
PointID2 := Integer(rpath.Net.FSRCNet.FPointIDs[rpath.Net.Points.IndexOf(path.p2)]);
height1 := GetZPointByID(rpath.Net.FSRCNet, PointID1);
height2 := GetZPointByID(rpath.Net.FSRCNet, PointID2);
end
else
begin
height1 := GetZPoint(rpath.Net,path.p1);
height2 := GetZPoint(rpath.Net,path.p2);
end;
if (EQDP(path.p1^,path.p2^))and(height1 <> height2)and(IFFiguraIsRoof(path.Net)) then
begin
found := false;
Break;
end
else
begin
prad := GetRadOfLine(path.p1^,path.p2^);
dAngle := abs(rad - prad);
if (dAngle > pi) then
dAngle := 2 * pi - dAngle;
dif := (2 * (pi / 180));
if not (dAngle <= dif ) then
prad := GetRadOfLine(path.p2^,path.p1^);
dAngle := abs(rad - prad);
if (dAngle > pi) then
dAngle := 2 * pi - dAngle;
if (dAngle <= dif ) then
begin
fPaths.Add(path);
p1 := path.OtherPoint(p1);
lPath := path;
found := true;
if fPaths.Count > 200 then
begin
fPaths.Clear;
break;
end;
end;
end;
end;
until (not found) or (xPaths.Count = 0);
lPath := rpath;
p1 := rpath.p2;
repeat
xPaths.Clear;
GetPathsOfKnot(p1,xPaths);
xPaths.Remove(lPath);
found := false;
for i := 0 to xPaths.Count - 1 do
begin
path := TNetPath(xPaths[i]);
if rpath.Net.FSRCNet <> nil then
begin
PointID1 := Integer(rpath.Net.FSRCNet.FPointIDs[rpath.Net.Points.IndexOf(path.p1)]);
PointID2 := Integer(rpath.Net.FSRCNet.FPointIDs[rpath.Net.Points.IndexOf(path.p2)]);
height1 := GetZPointByID(rpath.Net.FSRCNet, PointID1);
height2 := GetZPointByID(rpath.Net.FSRCNet, PointID2);
end
else
begin
height1 := GetZPoint(rpath.Net,path.p1);
height2 := GetZPoint(rpath.Net,path.p2);
end;
if (EQDP(path.p1^,path.p2^))and(height1 <> height2)and(IFFiguraIsRoof(path.Net)) then
begin
found := false;
Break;
end
else
begin
prad := GetRadOfLine(path.p1^,path.p2^);
if not Eqd(rad,prad) then
prad := GetRadOfLine(path.p2^,path.p1^);
if eqd(rad,prad) then
begin
fPaths.Add(path);
p1 := path.OtherPoint(p1);
lPath := path;
found := true;
if fPaths.Count > 200 then
begin
fPaths.Clear;
break;
end;
end;
end;
end;
until (not found) or (xPaths.Count = 0);
xPaths.free;
pList := TList.Create;
pList.Add(rPath.p1);
pList.Add(rPath.p2);
for i := 0 to fPaths.Count - 1 do
begin
Path := TNetPath(fPaths[i]);
if (pList.IndexOf(path.p1) = -1) then
pList.Add(path.p1);
if (pList.IndexOf(path.p2) = -1) then
pList.Add(path.p2);
end;
for i := 0 to pList.Count - 1 do
begin
p1 := PDoublePOint(pList[i]);
p1^:= Movepoint(p1^,dx,dy);
end;
Valid := True;
if Control then
begin
for i := 0 to pList.Count - 1 do
begin
p1 := PDoublePOint(pList[i]);
if (Not PathsValid(p1)) then
Valid := False;
end;
end;
if not Valid then
begin
for i := 0 to pList.Count - 1 do
begin
p1 := PDoublePOint(pList[i]);
p1^:= Movepoint(p1^,-dx,-dy);
end;
end;
fPaths.Free;
pList.Free;
//03.02.2012 ResetRegion;
//03.02.2012 Modified := True;
SetModified;
end;
procedure TNet.EqualTracePaths;
var
i: Integer;
path: TnetPath;
begin
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(Paths[i]);
if assigned(path.Opath) then
begin
path.p1.x := path.opath.p1.x;
path.p1.y := path.opath.p1.y;
path.p2.x := path.opath.p2.x;
path.p2.y := path.opath.p2.y;
end;
end;
end;
function TNet.DeletePathSilent(Path: TnetPath): Boolean;
var
i: Integer;
begin
result := false;
if assigned(UndoProc) then
UndoProc;
Paths.Remove(path);
CombinePathsOfKnot(path.p1);
CombinePathsOfKnot(path.p2);
RefreshPoints;
path.free;
RefreshColPositions;
RefreshPaths;
result := true;
end;
procedure TNet.UpdateWallThick(Value: Double);
var
i,k: Integer;
path: TNetPath;
begin
WallThick := Value;
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(Paths[i]);
path.Width := Value;
for k := 0 to path.Doors.Count - 1 do
TnetDoor(path.Doors[k]).Width := Value;
end;
RefreshPaths;
//03.02.2012 ResetRegion;
//03.02.2012 Modified := True;
SetModified;
end;
function TNet.FindLenToCloserStruct(p: TDoublePoint): Double;
var
i: Integer;
cDist: Double;
Struct: TNetStruct;
begin
result := -1;
for i := 0 to Structs.Count - 1 do
begin
Struct := TNetStruct(Structs[i]);
cDist := Struct.GetDistToPoint(p);
if (i = 0) or (cDist < Result) then
Result := cDist;
end;
end;
function TNet.CreateMoveTrace: TFigure;
var
Path: TNetPath;
index: Integer;
Clone: TNet;
MoveNet: TNet;
MoveNetPathLen: Double;
NetsByPt, NetsPathByPt: TList; //07.05.2012
NetByPt: TNet;
NetPathByPt: TNetPath;
NetPathByPtLen: Double;
CanMergeNets: Boolean;
RelNets: TList; //19.10.2010
//RelNets: TList; //07.05.2012
RelNet: TNet;
RelDupNet: TNet;
i: Integer;
RelPathTrace: TPathTrace;
NetList: TList;
procedure CreateNetCloneForTrace(APathTrace: TPathTrace);
begin
Clone := APathTrace.Path.Net.DuplicateByPath(APathTrace.Path, false, true);
Clone.FRelatedOwner := APathTrace;
Clone.DrawStyle := dsTrace;
Clone.color := clLime;
Clone.Style := 1;
Clone.width := 1;
Clone.Brs := 1;
Clone.RefreshPaths;
Clone.DefineInOutPoints;
APathTrace.Clone := Clone; //22.04.2011
APathTrace.FPathInClone := Clone.GetPathByPointsIn(APathTrace.Path.p1^, APathTrace.Path.p2^);
if APathTrace.FPathInClone <> nil then
APathTrace.FPathInCloneInversePt := Not PointNear(APathTrace.Path.p1^, APathTrace.FPathInClone.p1^);
end;
begin
result := nil;
if assigned(undoProc) then
UndoProc;
if SelType = stPath then
begin
// Tolik 28/09/2016-- ìîäåò ïðèäòè íîëèê - ïîëó÷èñ À (÷òî è íàáëþäàëüñü ðàíåå)
// index := SelIndex - 1;
if SelIndex > 0 then
index := SelIndex - 1
else
exit;
//
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
if Path.DoorIndex > -1 then
begin
Result := TDoorTrace.Create(Self, path, Path.ActiveDoor);
end
else
begin
//Clone := DuplicateByPath(Path, false, true);
//Clone.DrawStyle := dsTrace;
//Clone.color := clLime;
//Clone.Style := 1;
//Clone.width := 1;
//Clone.Brs := 1;
//Clone.RefreshPaths;
//Clone.DefineInOutPoints;
MoveNet := Self;
MoveNetPathLen := GetLineLenght(Path.p1^, Path.p2^);
//07.05.2012 - èùåì Net ñ ñàìûì áîëüøèì ñåãìåíòîì, â êîòîðûé ïîïàäàþò òî÷êè Path.p1, Path.p2
NetsPathByPt := TList.Create;
NetsByPt := GetNetsByPoints(TPowerCad(Owner), Path.p1, Path.p2, NetsPathByPt);
for i := 0 to NetsByPt.Count - 1 do
begin
NetByPt := TNet(NetsByPt[i]);
if NetByPt <> Self then
begin
CanMergeNets := true;
if Assigned(FOnMergeNetsQuery) then
FOnMergeNetsQuery(Self, NetByPt, CanMergeNets);
if CanMergeNets then
begin
NetPathByPt := NetsPathByPt[i];
NetPathByPtLen := GetLineLenght(NetPathByPt.p1^, NetPathByPt.p2^);
if NetPathByPtLen > MoveNetPathLen then
begin
MoveNet := NetByPt;
MoveNetPathLen := NetPathByPtLen;
Path := NetPathByPt;
end;
end;
end;
end;
NetsPathByPt.Free;
NetsByPt.Free;
Result := TPathTrace.Create(path, MoveNet, (ssShift in TPowercad(owner).CurrentShift), (ssCtrl in TPowercad(owner).CurrentShift));
//TPathTrace(Result).Clone := Clone; //22.04.2011
//TPathTrace(Result).FPathInClone := Clone.GetPathByPointsIn(Path.p1^, Path.p2^);
//if TPathTrace(Result).FPathInClone <> nil then
// TPathTrace(Result).FPathInCloneInversePt := Not PointNear(Path.p1^, TPathTrace(Result).FPathInClone.p1^);
TPathTrace(Result).SnappedNearPoint := TPowercad(Owner).SnapToNearPoint;
TPathTrace(Result).SnappedGrid := TPowerCad(Owner).SnapToGrids;
TPathTrace(Result).SnappedGuide := TPowerCad(Owner).SnapToGuides;
CreateNetCloneForTrace(TPathTrace(Result));
MoveNet.FRelatedNets.Clear;
//19.10.2010
if Not Path.IsArc then
begin
RelNets := MoveNet.GetRelatedNetsByPoints(Path.p1, Path.p2, citNone, true);
if RelNets <> nil then
begin
for i := 0 to RelNets.Count - 1 do
begin
RelNet := TNet(RelNets[i]);
RelNet.ClearRels;
RelDupNet := nil;
if RelNet.FRelatedObject <> nil then
begin
if (RelNet.FRelatedObject is TNetPath) and Not TNetPath(RelNet.FRelatedObject).IsArc then
begin
//24.05.2011
//RelPathTrace := TPathTrace.Create(TNetPath(RelNet.FRelatedObject), RelNet, (ssShift in TPowercad(owner).CurrentShift), (ssCtrl in TPowercad(owner).CurrentShift));
// RelPathTrace.SnappedNearPoint := TPowercad(Owner).SnapToNearPoint;
// RelPathTrace.SnappedGrid := TPowerCad(Owner).SnapToGrids;
// RelPathTrace.SnappedGuide := TPowerCad(Owner).SnapToGuides;
// RelPathTrace.FIsRelated := true;
// CreateNetCloneForTrace(RelPathTrace);
//
// RelPathTrace.FRelatedOwner := Result;
// TPathTrace(Result).FRelatedTraces.Add(RelPathTrace);
RelNet.FRelatedMPath := TNetPath(RelNet.FRelatedObject);
RelDupNet := RelNet.DuplicateByPath(TNetPath(RelNet.FRelatedObject), false, true);
RelDupNet.FRelatedMPath := RelDupNet.GetPathByNearPoints(RelNet.FRelatedMPath.p1, RelNet.FRelatedMPath.p2);
end;
end
else
if RelNet.FRelatedPoints.Count > 0 then
begin
RelNet.FRelatedMPoint := PDoublePoint(RelNet.FRelatedPoints[0]);
RelNet.FPathTracePoint := nil;
// Íàõîäèì ñ êàêîé òî÷êîé ñâÿçàí TPathTrace(Result)
if PointNear(RelNet.FRelatedMPoint^, TPathTrace(Result).p1) then
RelNet.FPathTracePoint := @TPathTrace(Result).p1
else
if PointNear(RelNet.FRelatedMPoint^, TPathTrace(Result).p2) then
RelNet.FPathTracePoint := @TPathTrace(Result).p2;
//24.05.2011 MoveNet.FRelatedNets.Add(RelNet);
RelDupNet := RelNet.DuplicateByKnot(RelNet.FRelatedMPoint, true); //13.05.2011 RelDupNet := RelNet.DuplicateByKnot(RelNet.FRelatedMPoint);
RelDupNet.FRelatedMPoint := RelDupNet.GetPointByNear(RelNet.FRelatedMPoint^);
//24.05.2011 RelDupNet.DrawStyle := dsTrace;
//24.05.2011 RelDupNet.color := clLime;
//24.05.2011 RelDupNet.Style := 1;
//24.05.2011 RelDupNet.width := 1;
//24.05.2011 RelDupNet.Brs := 1;
// Íàõîäèì ñ êàêîé òî÷êîé ñâÿçàí TPathTrace(Result)
//if PointNear(RelDupNet.FRelatedMPoint^, TPathTrace(Result).p1) then
// RelDupNet.FPathTracePoint := @TPathTrace(Result).p1
//else
//if PointNear(RelDupNet.FRelatedMPoint^, TPathTrace(Result).p2) then
// RelDupNet.FPathTracePoint := @TPathTrace(Result).p2;
RelDupNet.FPathTracePoint := RelNet.FPathTracePoint;
//24.05.2011 RelDupNet.FRelatedOwner := Result;
//24.05.2011 TPathTrace(Result).FRelatedNets.Add(RelDupNet);
end
else if CanMoveJoined then
begin
RelDupNet := TNet(RelNet.Duplicate);
RelDupNet.SetPathsHidden(true);
end;
if RelDupNet <> nil then //24.05.2011
begin
MoveNet.FRelatedNets.Add(RelNet);
RelDupNet.DrawStyle := dsTrace;
RelDupNet.color := clLime;
RelDupNet.Style := 1;
RelDupNet.width := 1;
RelDupNet.Brs := 1;
RelDupNet.FRelatedOwner := Result;
TPathTrace(Result).FRelatedNets.Add(RelDupNet);
RelDupNet.RefreshPaths;
RelDupNet.DefineInOutPoints;
end;
end;
RelNets.Free;
end;
if Assigned(FOnDefineMoveObjects) then
begin
NetList := TList.Create;
NetList.Assign(TPathTrace(Result).FRelatedNets);
NetList.Insert(0, TPathTrace(Result).Clone);
if FOnDefineMoveObjects(MoveNet, nil, Path, NetList) then
begin
for i := 0 to NetList.Count - 1 do
begin
TNet(NetList[i]).SetPathsHidden(false);
end;
end;
NetList.Free;
end;
end;
end;
end;
end;
end;
procedure TNet.CollectBoundPoints(p: TNetPath; var BPoints1,BPoints2: TDoublePointArr;
APathTrace: TPathTrace=nil);
var
i: Integer;
path: TNetPath;
ShowPathLengthType: TShowPathLengthType;
//procedure AddWidth(var AWidthInner, AWidthOuter: Double; APath: TNetPath);
//begin
//if (BWidth1 = 0) or (BWidth < APath.Width) then
//BWidth := APath.Width;
//AWidthInner := APath.
//end;
procedure AddWidth(ANumPt, APathPt: Integer; APath: TNetPath);
var
pt, PathPt: PDoublePoint;
NDrawPt, NDrawPtFrom: TDoublePoint;
begin
pt := nil;
case ANumPt of
1:
begin
if APathTrace <> nil then
begin
APathTrace.WidthInner1 := APath.InnerLen;
APathTrace.WidthOut1 := APath.OutLen;
end;
pt := p.p1;
end;
2:
begin
if APathTrace <> nil then
begin
APathTrace.WidthInner2 := APath.InnerLen;
APathTrace.WidthOut2 := APath.OutLen;
end;
pt := p.p2;
end;
end;
APath.DefineInOutPoints;
PathPt := nil;
NDrawPt := DoublePoint(0,0);
NDrawPtFrom := DoublePoint(0,0);
{//28.04.2012
case APathPt of
1:
begin
PathPt := APath.p1;
case ShowPathLengthType of
sltPoints:
begin
NDrawPt := APath.p1^;
NDrawPtFrom := APath.p2^;
end;
sltInner:
begin
NDrawPt := APath.ip1^;
NDrawPtFrom := APath.ip2^;
end;
sltOuter:
begin
NDrawPt := APath.op1^;
NDrawPtFrom := APath.op2^;
end;
end;
end;
2:
begin
PathPt := APath.p2;
case ShowPathLengthType of
sltPoints:
begin
NDrawPt := APath.p2^;
NDrawPtFrom := APath.p1^;
end;
sltInner:
begin
NDrawPt := APath.ip2^;
NDrawPtFrom := APath.ip1^;
end;
sltOuter:
begin
NDrawPt := APath.op2^;
NDrawPtFrom := APath.op1^;
end;
end;
end;
end;}
//28.04.2012
PathPt := APath.GetPointByLenghType(APathPt, sltPoints);
NDrawPt := APath.GetPointByLenghType(APathPt, ShowPathLengthType)^;
NDrawPtFrom := APath.GetPointByLenghType(GetOtherSide(APathPt), ShowPathLengthType)^;
if (pt <> nil) and (PathPt <> nil) then
begin
PointToLine(pt^, PathPt^, NDrawPt.x, NDrawPt.y);
PointToLine(pt^, PathPt^, NDrawPtFrom.x, NDrawPtFrom.y);
case APathPt of
1:
begin
SetLength(BPoints1,Length(BPoints1)+1);
BPoints1[Length(BPoints1)-1] := APath.p1^;
if APathTrace <> nil then
begin
SetLength(APathTrace.NDrawPoints1,Length(APathTrace.NDrawPoints1)+1);
APathTrace.NDrawPoints1[Length(APathTrace.NDrawPoints1)-1] := NDrawPt;
APathTrace.FDrawP1 := NDrawPtFrom;
end;
end;
2:
begin
SetLength(BPoints2,Length(BPoints2)+1);
BPoints2[Length(BPoints2)-1] := APath.p2^;
if APathTrace <> nil then
begin
SetLength(APathTrace.NDrawPoints2,Length(APathTrace.NDrawPoints2)+1);
APathTrace.NDrawPoints2[Length(APathTrace.NDrawPoints2)-1] := NDrawPt;
APathTrace.FDrawP2 := NDrawPtFrom;
end;
end;
end;
end;
end;
begin
SetLength(BPoints1,0);
SetLength(BPoints2,0);
if APathTrace <> nil then
begin
APathTrace.WidthInner1 := 0;
APathTrace.WidthInner2 := 0;
APathTrace.WidthOut1 := 0;
APathTrace.WidthOut2 := 0;
SetLength(APathTrace.NDrawPoints1,0);
SetLength(APathTrace.NDrawPoints2,0);
end;
ShowPathLengthType := sltInner;
if Assigned(p.FOnGetShowPathTraceLengthType) then
ShowPathLengthType := p.FOnGetShowPathTraceLengthType(p);
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(paths[i]);
if path <> p then
begin
if (path.p1 = p.p1) then
begin
//18.04.2011 SetLength(BPoints1,Length(BPoints1)+1);
//18.04.2011 BPoints1[Length(BPoints1)-1] := path.p2^;
AddWidth(1, 2, path);
end
else
if (path.p2 = p.p1) then
begin
//18.04.2011 SetLength(BPoints1,Length(BPoints1)+1);
//18.04.2011 BPoints1[Length(BPoints1)-1] := path.p1^;
AddWidth(1, 1, path);
end
else
if (path.p1 = p.p2) then
begin
//18.04.2011 SetLength(BPoints2,Length(BPoints2)+1);
//18.04.2011 BPoints2[Length(BPoints2)-1] := path.p2^;
AddWidth(2, 2, path);
end
else
if (path.p2 = p.p2) then
begin
//18.04.2011 SetLength(BPoints2,Length(BPoints2)+1);
//18.04.2011 BPoints2[Length(BPoints2)-1] := path.p1^;
AddWidth(2, 1, path);
end;
end;
end;
end;
procedure TNet.DeleteNonePaths;
var
i, k: Integer;
path: TNetPath;
delList: Tlist;
xPath: TnetPath;
begin
DelList := TList.Create;
for i := 0 to Paths.Count - 1 do
begin
path := TnetPath(Paths[i]);
if EqDp(path.p1^,path.p2^) then
begin
DelList.Add(path);
for k := 0 to Paths.Count - 1 do
begin
xPath := TnetPath(Paths[k]);
if DelList.IndexOf(xPath) = -1 then
begin
if (xPath.p1 = path.p2) then
xPath.p1 := path.p1
else
if (xPath.p2 = path.p2) then
xPath.p2 := path.p1;
end;
end;
end;
end;
try
for i := 0 to DelList.Count - 1 do
begin
xPath := TnetPath(Dellist[i]);
Paths.Remove(xPath);
xPath.Free;
end;
except
// ShowMessage(CPowerCadMessage + 'TNet.DeleteNonePaths');
end;
if Dellist.Count > 0 then
RefreshPoints;
Dellist.Free;
end;
procedure TNet.FindBottomPaths(pathList, ReList: TList);
var
i: Integer;
mp,cp: TDoublePoint;
path: TnetPath;
begin
cp := GetCenterOfPaths(pathList);
for i := 0 to pathList.Count - 1 do
begin
path:= TnetPath(Pathlist[i]);
mp := MPoint(path.p1^,path.p2^);
if (mp.y > cp.y) and (path.PosType <> ptVertical) then
Relist.Add(Path);
end;
end;
function TNet.FindClosedRegions(pathList:TList): TList;
var
vetPaths: TList;
horPaths: TList;
path: TnetPath;
i: Integer;
Points: TStringList;
Points2: TStringList;
begin
Result := nil; //#From Oleg# //14.09.2010
vetPaths := TList.Create;
horPaths := TList.Create;
Points := TStringList.Create;
Points2 := TStringList.Create;
try
for i := 0 to pathList.Count - 1 do
begin
path := TnetPath(Pathlist[i]);
Points.Add('(p1.x, p1.y) (p2.x, p2.y) ('+FloatToStr(path.p1^.x)+' '+FloatToStr(path.p1^.y)+') ('+FloatToStr(path.p2^.x)+' '+FloatToStr(path.p2^.y)+')');
Points2.Add('(a1.x, a1.y)-(b1.x, b1.y) (a2.x, a2.y)-(b2.x, b2.y) ('+
FloatToStr(path.a1.x)+' '+FloatToStr(path.a1.y)+')-('+FloatToStr(path.b1.x)+' '+FloatToStr(path.b1.y)+')'+
FloatToStr(path.a2.x)+' '+FloatToStr(path.a2.y)+')-('+FloatToStr(path.b2.x)+' '+FloatToStr(path.b2.y)+')'
);
if path.PosType = ptHorizontal then
horPaths.Add(path)
else if path.PosType = ptVertical then
vetPaths.Add(path);
end;
finally
FreeAndNil(Points);
FreeAndNil(Points2);
FreeAndNil(vetPaths);
FreeAndNil(horPaths);
end;
end;
procedure TNet.FindLeftPaths(pathList, ReList: TList);
var
i: Integer;
mp,cp: TDoublePoint;
path: TnetPath;
begin
cp := GetCenterOfPaths(pathList);
for i := 0 to pathList.Count - 1 do
begin
path := TnetPath(Pathlist[i]);
mp := MPoint(path.p1^,path.p2^);
if (mp.x < cp.x) and (path.PosType <> ptHorizontal) then
Relist.Add(Path);
end;
end;
procedure TNet.FindRightPaths(pathList, ReList: TList);
var
i: Integer;
mp,cp: TDoublePoint;
path: TnetPath;
begin
cp := GetCenterOfPaths(pathList);
for i := 0 to pathList.Count - 1 do
begin
path:= TnetPath(Pathlist[i]);
mp := MPoint(path.p1^,path.p2^);
if (mp.x > cp.x) and (path.PosType <> ptHorizontal) then
Relist.Add(Path);
end;
end;
procedure TNet.FindTopPaths(pathList, ReList: TList);
var
i: Integer;
mp,cp: TDoublePoint;
path: TnetPath;
begin
cp := GetCenterOfPaths(pathList);
for i := 0 to pathList.Count - 1 do
begin
path:= TnetPath(Pathlist[i]);
mp := MPoint(path.p1^,path.p2^);
if (mp.y < cp.y) and (path.PosType <> ptVertical) then
Relist.Add(Path);
end;
end;
function TNet.GetCenterOfPaths(Paths: TList): TDoublePoint;
var
i: Integer;
path: TNetPath;
px,py: Double;
minx,miny,maxX,maxY: Double;
begin
result := DoublePOint(0,0);
if paths.Count = 0 then
exit;
Path := TNetPath(Paths[0]);
minx := path.p1^.x;
miny := path.p1^.y;
maxx := path.p1^.x;
maxy := path.p1^.y;
for i:= 0 to Paths.Count - 1 do
begin
Path := TNetPath(Paths[i]);
px := path.p1^.x;
py := path.p1^.y;
if px < minx then
minx := px;
if py < miny then
miny := py;
if px > maxx then
maxx := px;
if py > maxy then
maxy := py;
px := path.p2^.x;
py := path.p2^.y;
if px < minx then
minx := px;
if py < miny then
miny := py;
if px > maxx then
maxx := px;
if py > maxy then
maxy := py;
end;
Result := DoublePoint((minx + maxx) / 2, (miny + maxy) / 2);
end;
function TNet.FindMostEPath(pathList: TList): TNetPath;
var
path: TnetPath;
mp: TDoublePOint;
ms,ds,mE,dE: Double;
i: Integer;
begin
result := nil;
if pathList.Count = 0 then
exit;
path := TnetPath(pathList[0]);
mp := MPoint(path.p1^,path.p2^);
mS := WorkHeight - mp.y;
mE := mp.x;
for i := 1 to pathList.Count - 1 do
begin
path := TnetPath(pathList[i]);
mp := MPoint(path.p1^,path.p2^);
dS := WorkHeight-mp.y;
dE := mp.x;
if dE > mE then
begin
result := path;
mS := ds;
mE := dE;
end;
end;
end;
procedure TNet.DeleteRegions;
var
i: Integer;
path: TnetPath;
begin
if PathRgn <> 0 then // Tolik 21/11/2019 --
DeleteObject(PathRgn);
PathRgn := 0;
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(Paths[i]);
Path.DeleteRegions;
end;
end;
procedure TNet.DivSelPath(mp: TDoublePOint);
var
index,i: Integer;
path: TNetPath;
xp1,xp2:TdoublePoint;
xp,op:PDoublePoint;
begin
if (SelIndex > 0) and (selType = stPath) then
begin
index := SelIndex-1;
if assigned(undoProc) then
UndoProc;
if index < Paths.Count then
begin
Path := TNetPath(Paths[Index]);
Path.BeforeDiv; //06.10.2010
try
xp1 := path.p1^;
xp2 := path.p2^;
PointtoLine(xp1,xp2,mp.x,mp.y);
xp := InsertKnot(mp);
RefreshPaths;
finally
Path.AfterDiv;
end;
end;
end;
end;
function TNet.DivPath(APath: TNetPath; APoint: TDoublePoint): PDoublePoint;
var
xp1,xp2:TdoublePoint;
xp,op:PDoublePoint;
begin
Result := nil;
if APath.Net = Self then
begin
APath.BeforeDiv; //06.10.2010
try
xp1 := APath.p1^;
xp2 := APath.p2^;
PointtoLine(xp1,xp2,APoint.x,APoint.y);
xp := InsertKnot(APoint);
Result := xp;
RefreshPaths;
finally
APath.AfterDiv; //06.10.2010
end;
end;
end;
procedure TNet.DrawRelated(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
i: Integer;
begin
try
for i := 0 to FRelatedNets.Count - 1 do
TNet(FRelatedNets[i]).draw(DEngine, isGrayed);
except
on E: Exception do AddExceptionToLogEx('', E.Message);
end;
end;
procedure TNet.DoClick(X, Y: Double);
var
Path, NetSelPath: TNetPath;
ModPoint: TModPoint;
SelectedPt: Boolean;
PathChild: TNetDoor;
begin
if Not FFigureModification and Not CheckOtherNetModification then
begin
SelectedPt := false;
if (Self.SelPt <> nil) then
begin
//ModPoint := TPCDrawing(Self.Owner).HitTestModPoint(x,y);
//if (ModPoint <> nil) and (ModPoint.Figure = Self.Net) and (ModPoint.SeqNbr = Self.FSelPtIdx) then
if PointNear(PDoublePoint(Points[FSelPtIdx])^, DoublePoint(x, y)) then
begin
SelectedPt := true;
Self.DoClickPoint(PDoublePoint(Points[FSelPtIdx]));
end;
end;
if Not SelectedPt then
begin
Path := nil;
NetSelPath := Self.SelPath; //22.08.2011
if (NetSelPath <> nil) and (NetSelPath.IsPointIn(x, y)) then
Path := NetSelPath
else
Path := Self.GetPathOfPoint(x, y);
if Path <> nil then
begin
PathChild := Path.ActiveDoor;
if PathChild <> nil then
PathChild.DoClick
else
Path.DoClick(x, y);
end;
end;
end;
end;
procedure TNet.DoClickPoint(APoint: PDoublePoint);
var
PointIndex: Integer;
begin
SelectPt(APoint);
//ReSelect; // Ñáðîñèòü ModPoint ñåãìåíòà è ïîëó÷èòü ModPoint òî÷êè
if Assigned(FOnSelectPoint) then
begin
FSelectingPt := true;
try
PointIndex := Points.IndexOf(APoint);
if PointIndex <> -1 then
FOnSelectPoint(Self, APoint, Integer(FPointIDs[PointIndex]));
finally
FSelectingPt := false;
end;
end;
end;
procedure TNet.DefineInOutPoints;
var
i: Integer;
begin
for i := 0 to Paths.Count - 1 do
if Not TNetPath(Paths[i]).FIsHidden then
TNetPath(Paths[i]).DefineInOutPoints;
end;
procedure TNet.DeleteNet;
var
Net: TNet;
Path: TNetPath;
Col: TNetCol;
i: integer;
begin
if Not FDeleting then
begin
Net := Self;
i := 0;
while i < Net.Paths.Count do
begin
Path := TNetPath(Net.Paths[i]);
Net.DeletePath(Path);
end;
i := 0;
while i < Net.Structs.Count do
begin
Col := TNetCol(Net.Structs[i]);
Net.DeleteStruct(Col);
end;
DoDelete;
if Assigned(Parent) and (Parent is TFigureGrp) then
TFigureGrp(Parent).RemoveFromGrp(Self);
TPowerCad(Owner).Figures.Remove(Self);
end;
end;
procedure TNet.AfterUndo(Sender: TObject);
var
i: integer;
Path: TNetPath;
begin
for i := 0 to Paths.Count - 1 do
begin
Path := TNetPath(Paths[i]);
Path.AfterLoadProps;
end;
end;
function TNet.CanMoveJoined: Boolean;
begin
Result := Not (ssAlt in GGlobalShiftState); //Not (ssShift in GGlobalShiftState);
end;
Function TNet.CheckForPoints(pp: TDoublePoint; aPrevPoint: PDoublePoint = nil): PDoublePoint;
var
xp: PDoublePoint;
k: Integer;
LastDist: Double;
CurrDist: Double;
begin
result := nil;
LastDist := -1;
for k := 0 to Points.Count - 1 do
begin
if Points[k] <> aPrevPoint then
begin
xp := PDoublePoint(Points[k]);
//if EQDP(xp^, pp) then
// begin
CurrDist := GetLineLenght(xp^, pp);
if CurrDist <= (WallThick / 2) then
begin
if (LastDist = -1) or (LastDist > CurrDist) then
begin
LastDist := CurrDist;
result := xp;
//exit;
end;
end;
end;
end;
end;
function TNet.CheckIntersect(ANet: TNet): Boolean;
var
i: integer;
begin
Result := false;
for i := 0 to ANet.Points.Count - 1 do
if Self.GetPointByNear(PDoublePoint(ANet.Points[i])^) <> nil then
begin
Result := true;
Break; //// BREAK ////
end;
end;
function TNet.CheckLocatePoint(p: PDoublePoint; x, y: Double): Boolean;
var
oldx,oldy: Double;
begin
oldx := p.x;
oldy := p.y;
p.x := x;
p.y := y;
Result := PathsValid(p);
p.x := oldx;
p.y := oldy;
end;
function TNet.CheckOtherNetModification: Boolean;
var
TraceFigure: TFigure;
begin
Result := false;
try
TraceFigure := TPCDrawing(Self.Owner).TraceFigure;
if Assigned(TraceFigure) and (TraceFigure is TNet) then
begin
if (TNet(TraceFigure).FSrcNet <> nil) and (TNet(TraceFigure).FSrcNet.FFigureModification) then
Result := true;
end;
except
end;
end;
function TNet.CheckPtInJoinedMove(Apt: PDoublePoint): Boolean;
var
i: Integer;
Path: TNetPath;
begin
Result := false;
if FJoinedMovePoints.IndexOf(Apt) <> -1 then
Result := true
else
for i := 0 to FJoinedMovePaths.Count - 1 do
begin
Path := TNetPath(FJoinedMovePaths[i]);
if (Path.p1 = Apt) or (Path.p2 = Apt) then
begin
Result := true;
Break; //// BREAK ////
end;
end;
end;
procedure TNet.ClearRels;
begin
FRelatedNets.Clear;
FRelatedOwner := nil;
FRelatedMPoint := nil;
FRelatedMPath := nil;
end;
procedure TNet.ClearSavedScaledPoints;
begin
ClearPointsList(FSavedScaledPoints);
end;
procedure TNet.ClearSavedPoints;
//var
// i: Integer;
begin
//for i := 0 to FSavedPoints.Count - 1 do
// FreeMem(FSavedPoints[i], SizeOf(TDoublePoint));
//FSavedPoints.Clear;
ClearPointsList(FSavedPoints);
end;
procedure TNet.ClearPointsList(AList: TList);
var
i: Integer;
begin
for i := 0 to AList.Count - 1 do
FreeMem(AList[i], SizeOf(TDoublePoint));
AList.Clear;
end;
function TNet.CmpIntersectPaths(p1,p2, ap1, ap2: PDoublePoint; MarginDelta:Double = 2; AEqualRotate: Pointer=nil): Integer;
var
p1InAPath, p2InAPath: Boolean;
ap1InPath, ap2InPath: Boolean;
begin
Result := citNone;
if AEqualRotate <> nil then
Boolean(AEqualRotate^) := false;
if (PointNear(p1^, ap1^) and PointNear(p2^, ap2^)) then
Result := citEqual
else if (PointNear(p1^, ap2^) and PointNear(p2^, ap1^)) then
begin
Result := citEqual;
if AEqualRotate <> nil then
Boolean(AEqualRotate^) := true;
end
else
begin
p1InAPath := isPointInLine(ap1^, ap2^, p1^,1,MarginDelta);
p2InAPath := isPointInLine(ap1^, ap2^, p2^,1,MarginDelta);
ap1InPath := isPointInLine(p1^,p2^, ap1^,1,MarginDelta);
ap2InPath := isPointInLine(p1^,p2^, ap2^,1,MarginDelta);
if p1InAPath and p2InAPath then
Result := citEntry
else
if ap1InPath and ap2InPath then
Result := citAbsorb
else
if p1InAPath or p2InAPath or ap1InPath or ap2InPath then
Result := citSide;
end;
end;
function TNet.CmpDP(p1,p2: PDoublePoint): Boolean;
begin
Result := false;
if FCmpPointPrecision <> -1 then
Result := PointNear(p1^,p2^, FCmpPointPrecision)
else
Result := EQDP(p1^, p2^);
end;
function TNet.CreateDuplicate: TNet;
var
Res: TNet;
i,j: Integer;
path, xPath: TNetPath;
door, XDoor: TNetDoor;
pId: Integer;
p1,p2: PDoublePoint;
pt1: TnetPath;
begin
Result := nil;
Res := Tnet.Create(LayerHandle, DrawStyle, Owner);
Res.FSrcNet := Self; //21.10.2010
Res.MapScale := MapScale;
Res.WorldDim := WorldDim;
Res.Clear;
For i := 0 to Points.Count - 1 do
begin
p1 := PDoublePoint(points[i]);
res.AddPoint(p1^);
end;
for i := 0 to Paths.Count - 1 do
begin
p1 := nil;
p2 := nil;
xPath := nil; //#From Oleg# //14.09.2010
path := TNetPath(paths[i]);
pId := Points.IndexOf(path.p1);
if (pId > -1) and (pId < res.Points.Count) then
p1 := PDoublePoint(res.Points[pId]);
pId := Points.IndexOf(path.p2);
if (pId > -1) and (pId < res.Points.Count) then
p2 := PDoublePoint(res.Points[pId]);
if assigned(p1) and assigned(p2) then
xPath := res.AddPath(p1,p2,path.Border);
if assigned(xPath) then
begin
xPath.Info := Path.Info;
xPath.Width := Path.Width;
xPath.AssignProps(Path);
xPath.Opath := path;
for j := 0 to path.Doors.Count - 1 do
begin
door := TNetDoor(path.Doors[j]);
XDoor := TnetDoor.Create(door.Start,door.Width,door.Len,door.DoorObjType, xPath.net);
XDoor.FPath := XPath;
XDoor.DoorType := door.DoorType;
XDoor.DoorObjType := door.DoorObjType;
XDoor.FComponID := door.FComponID;
XDoor.FSrcDoor := door;
XDoor.FRotation := door.FRotation;
XPath.doors.Add(XDoor);
end;
end;
end;
Tnet(Res).WallThick := WallThick;
Tnet(Res).EndDraw := EndDraw;
Tnet(Res).ContextMenu := ContextMenu;
Tnet(Res).DrawGuides := DrawGuides;
Tnet(Res).EditMode := EditMode;
Result := res;
//Result := TNet(duplicate);
if Assigned(FOnDuplicate) then
FOnDuplicate(Self, Result);
end;
procedure TNet.BeforeDelFromParent(Sender: TObject);
begin
//if Assigned(Parent) and (Parent is TFigureGrp) then
// DoDelete;
end;
procedure TNet.DeletePoint(APoint: PDoublePoint);
var
Index: Integer;
begin
Index := Points.IndexOf(APoint);
if Index <> -1 then
begin
if Assigned(FOnDeletePoint) then
FOnDeletePoint(Self, APoint, Integer(FPointIDs[Index]));
Points.Delete(Index);
Dispose(APoint);
FPointIDs.Delete(Index);
end;
end;
procedure TNet.DeSelect;
begin
// Åñëè íå âûäåëÿåì ýòîò îáúåêò ñíîâà äëÿ âûäåëåíèÿ äðóãîãî ñåãìåíòà
if Not ((ssCtrl in GGlobalShiftState) and TPCDrawing(Owner).FIsSelectingFig) then
begin
inherited ;
if Not FDeleting then
begin
SelectPath(0);
SelectPt(nil);
end;
end;
end;
procedure TNet.DoDelete;
begin
if Not FDeleting then
begin
FDeleting := true;
if Assigned(FOnDelete) then
FOnDelete(Self);
end;
end;
procedure TNet.DoResize;
begin
if Assigned(FOnResize) then
FOnResize(Self);
end;
function TNet.FindPathInRelatedNearPoints(Ap1, Ap2: PDoublePoint): TNetPath;
var
i: Integer;
begin
Result := nil;
for i := 0 to FRelatedNets.Count - 1 do
begin
Result := TNet(FRelatedNets[i]).GetPathByNearPoints(Ap1, Ap2);
if Result <> nil then
Break; //// BREAK ////
end;
end;
function TNet.ExistsPathOnPathTrajectory(aPath: TNetPath; beginP1, beginP2: PDoublePoint): Boolean;
var
i: Integer;
Path: TNetPath;
begin
Result := false;
for i := 0 to Paths.Count - 1 do
begin
Path := TNetPath(Paths[i]);
if Path <> aPath then
begin
if (IsPointInLine(beginP1^, aPath.p1^, Path.p1^, 1, 0.1) and
IsPointInLine(beginP2^, aPath.p2^, Path.p2^, 1, 0.1)) or
(IsPointInLine(beginP1^, aPath.p1^, Path.p2^, 1, 0.1) and
IsPointInLine(beginP2^, aPath.p2^, Path.p1^, 1, 0.1)) then
begin
Result := true;
Break; //// BREAK ////
end;
end;
end;
end;
function TNet.GetContureByPt: TDoublePointArr;
var
i: integer;
basep, p, ConnPt, ConnCheckPt: PDoublePoint;
LookedPoints: TList;
NextPath, Path: TNetPath;
Done: Boolean;
PIndex: integer;
procedure AddPoint(pt: PDoublepoint);
begin
SetLength(Result, Length(Result) + 1);
Result[Length(Result)-1] := pt^;
LookedPoints.Add(pt);
end;
begin
try
SetLength(Result, 0);
basep := nil;
if Paths.Count > 0 then
basep := TNetPath(Paths[0]).p1;
if basep <> nil then
begin
LookedPoints := TList.Create;
Done := False;
p := basep;
repeat
AddPoint(p);
ConnPt := nil;
for i := 0 to Paths.Count - 1 do
begin
Path := Paths[i];
ConnCheckPt := nil;
if Path.p1 = p then
ConnCheckPt := Path.p2
else if Path.p1 = p then
ConnCheckPt := Path.p1;
if (ConnCheckPt <> nil) and ((ConnCheckPt = basep) or (LookedPoints.IndexOf(ConnCheckPt) = -1)) then
begin
ConnPt := ConnCheckPt;
Break; //// BREAK ////
end;
end;
p := ConnPt;
if (p = nil) or (ConnCheckPt = basep) then
Done := true;
until Done;
LookedPoints.Free;
end;
except
on E: Exception do AddExceptionToLogExt(ClassName, 'GetContureByPt', E.Message);
end;
end;
function TNet.GetLengthForShow(ALength: Double): Double;
begin
Result := ALength;
if WorldDim then
Result := Result / 1000 * MapScale
else
Result := Result / 10;
end;
function TNet.GetMainTraceNet: TNet;
begin
Result := nil;
if Assigned(FRelatedOwner) then
begin
if (FRelatedOwner is TNet) then
Result := TNet(FRelatedOwner)
else if (FRelatedOwner is TPathTrace) then
begin
if Assigned(TPathTrace(FRelatedOwner).FRelatedOwner) then
begin
if TPathTrace(FRelatedOwner).FRelatedOwner is TPathTrace then
if Assigned(TPathTrace(TPathTrace(FRelatedOwner).FRelatedOwner).Clone) then
Result := TPathTrace(TPathTrace(FRelatedOwner).FRelatedOwner).Clone;
end
else if Assigned(TPathTrace(FRelatedOwner).Clone) then
Result := TPathTrace(FRelatedOwner).Clone;
end
end
else
Result := Self;
end;
function TNet.GetObjInPoint(x, y: Double): TObject;
var
i: Integer;
path: TNetPath;
struct: TnetStruct;
Obj: TObject;
begin
Result := nil;
for i := 0 to Structs.Count - 1 do
begin
struct := TnetStruct(Structs[i]);
if struct.IsPointIn(x, y) then
begin
Result := struct;
exit;
end;
end;
for i := 0 to Paths.Count - 1 do
begin
Path := TNetPath(paths[i]);
Obj := Path.GetObjInPoint(x,y);
if Obj <> nil then
begin
Result := Obj;
exit;
end;
end;
end;
function TNet.GetPathByMainPoint(APoint: TDoublePoint): TNetPath;
var
i: Integer;
Path: TNetPath;
begin
Result := nil;
for i := 0 to Paths.Count - 1 do
begin
Path := TNetPath(Paths[i]);
if CmpPoints(Path.p1^, APoint) or CmpPoints(Path.p2^, APoint) then
begin
Result := Path;
Exit; ///// EXIT /////
end;
end;
end;
function TNet.GetPathByNearPoints(APoint1, APoint2: PDoublePoint; delta: Double=1): TNetPath;
var
i: Integer;
Path: TnetPath;
begin
Result := nil;
if (APoint1 <> nil) and (APoint2 <> nil) then
begin
for i := 0 to Paths.Count - 1 do
begin
Path := TNetPath(Paths[i]);
if (PointNear(APoint1^, Path.p1^, delta) and PointNear(APoint2^, Path.p2^, delta)) or
(PointNear(APoint1^, Path.p2^, delta) and PointNear(APoint2^, Path.p1^, delta)) then
begin
Result := Path;
Break; //// BREAK ////
end;
end;
end;
end;
function TNet.GetPathByPointsIn(p1, p2: TDoublePoint): TNetPath;
var
i: Integer;
path: TnetPath;
begin
Result := nil;
for i := 0 to Paths.Count - 1 do
begin
path := TNetPath(Paths[i]);
//if path.isPointIn(p1.x, p1.y) and path.isPointIn(p2.x, p2.y) then
if isPointInLine(path.p1^,path.p2^,DoublePoint(p1.x, p1.y),1) and
isPointInLine(path.p1^,path.p2^,DoublePoint(p2.x, p2.y),1) then
begin
Result := path;
exit;
end;
end;
end;
function TNet.GetPathCountByPoint(aPt: PDoublePoint): Integer;
var
i: integer;
begin
Result := 0;
if aPt <> nil then
for i := 0 to Paths.Count - 1 do
if TNeTPath(Paths[i]).isKnotIn(aPt) <> 0 then
Inc(Result);
end;
function TNet.GetPathListByPoint(APoint: PDoublePoint): TList;
var
i: Integer;
Path: TNetPath;
begin
Result := nil;
if APoint <> nil then
begin
Result := TList.Create;
for i := 0 to Paths.Count - 1 do
begin
Path := TNetPath(Paths[i]);
if (Path.p1 = APoint) or (Path.p2 = APoint) then
Result.Add(Path);
end;
end;
end;
function TNet.GetPathListByPointID(APointID: Integer): TList;
begin
Result := GetPathListByPoint(GetPointByID(APointID));
end;
function TNet.GetPoint(x,y: Double; AOtherNearPoints: TList=nil): PDoublePoint;
var
i: integer;
pt: TDoublePoint;
begin
Result := nil;
pt.x := x;
pt.y := y;
for i := 0 to Points.Count - 1 do
begin
if EQDP(PDoublePoint(Points[i])^, pt) then
begin
if (AOtherNearPoints <> nil) and (Result <> nil) then
AOtherNearPoints.Add(Result);
Result := Points[i];
Break; //// BREAK ////
end;
end;
end;
function TNet.GetPointByNear(ANearPoint: TDoublePoint; ASkipList: TList): PDoublePoint;
var
i: Integer;
p: PDoublePoint;
begin
Result := nil;
for i := 0 to Points.Count - 1 do
begin
p := PDoublePoint(Points[i]);
if (Not Assigned(ASkipList) or (ASkipList.IndexOf(p)=-1)) and PointNear(ANearPoint, p^) then
begin
Result := p;
Break; //// BREAK ////
end;
end;
end;
function TNet.GetPointsByNear(ANearPoint: TDoublePoint; ASkipList: TList=nil): TList;
var
i: Integer;
p: PDoublePoint;
begin
Result := TList.Create;
for i := 0 to Points.Count - 1 do
begin
p := PDoublePoint(Points[i]);
if (Not Assigned(ASkipList) or (ASkipList.IndexOf(p)=-1)) and PointNear(ANearPoint, p^) then
Result.Add(p);
end;
end;
function TNet.GetPointByID(APointID: Integer): PDoublePoint;
var
PointIndex: Integer;
begin
Result := nil;
PointIndex := FPointIDs.IndexOf(Pointer(APointID));
if PointIndex <> -1 then
Result := Points[PointIndex];
end;
function TNet.GetPointFromList(AList: TList; ANetPt: PDoublePoint): PDoublePoint;
var
Idx: Integer;
begin
Result := nil;
if Points.Count = AList.Count then
begin
Idx := Points.IndexOf(ANetPt);
if Idx <> -1 then
Result := AList[Idx];
end;
end;
function TNet.GetPointID(APoint: PDoublePoint): Integer;
var
PointIndex: Integer;
begin
Result := 0;
PointIndex := Points.IndexOf(APoint);
if PointIndex <> -1 then
Result := Integer(FPointIDs[PointIndex]);
end;
function TNet.GetPointPath(APoint: PDoublePoint): TNetPath;
var
i: Integer;
begin
Result := nil;
for i := 0 to Paths.Count - 1 do
if TNetPath(Paths[i]).SecondPoint(APoint) <> nil then
begin
Result := TNetPath(Paths[i]);
Break; //// BREAK ////
end;
end;
function TNet.GetSavedScaledPtByPoint(pt: PDoublePoint): PDoublePoint;
begin
Result := GetPointFromList(FSavedScaledPoints, pt);
end;
function TNet.GetSavedPtByPoint(pt: PDoublePoint): PDoublePoint;
//var
// Idx: Integer;
begin
//Result := nil;
//if Points.Count = FSavedPoints.Count then
//begin
// Idx := Points.IndexOf(pt);
// if Idx <> -1 then
// Result := FSavedPoints[Idx];
//end;
Result := GetPointFromList(FSavedPoints, pt);
end;
function TNet.GetSelectedObject: TObject;
begin
Result := Self.SelPath;
if Result <> nil then
if TNetPath(Result).ActiveDoor <> nil then
Result := TNetPath(Result).ActiveDoor;
end;
function TNet.IsPathDrawed(ap1, ap2: PDoublePoint): Boolean;
var
i: integer;
p1, p2: PDoublePoint;
begin
Result := false;
for i := 0 to FDrawedPt1.Count - 1 do
begin
p1 := FDrawedPt1[i];
p2 := FDrawedPt2[i];
if (PointNear(p1^, ap1^) and PointNear(p2^, ap2^)) or
(PointNear(p1^, ap2^) and PointNear(p2^, ap1^)) then
begin
Result := true;
Break; //// BREAK ////
end;
end;
end;
function TNet.IsPointInArc(p: PDoublePoint): Boolean;
var
i: Integer;
Path: TNetPath;
begin
Result := false;
for i := 0 to Paths.Count - 1 do
begin
Path := TNetPath(Paths[i]);
if Path.isArc and ((Path.p1 = p) or (Path.p1 = p)) then
begin
Result := true;
Break; //// BREAK ////
end;
end;
end;
function TNet.IsRectangle: Boolean;
var
Angle90Count: Integer;
i, j: integer;
FirstPt, PrevPt: PDoublePoint;
Path, FirstPath, PrevPath, PathI, PathJ: TNetPath;
LastDistToOrigin, DistToOrigin: Double;
pc, pi, pj: PDoublePoint;
Angle: Double;
begin
Result := false;
//
if Paths.Count >= 4 then
begin
Angle90Count := 0;
//28.04.2012 - èùåì ñåãìåíò, êîòîðûé áëèæå ê íà÷àëó êîîðäèíàò - äëÿ òîãî ÷òîáû íå áåãàòü ïî ïåðåãîðîäêàì
FirstPath := nil;
FirstPt := nil;
LastDistToOrigin := -1;
for i := 0 to Points.Count - 1 do
begin
DistToOrigin := GetLineLength(DoublePoint(0,0), PDoublePoint(Points[i])^);
if (FirstPt = nil) or (DistToOrigin < LastDistToOrigin) then
begin
FirstPt := Points[i];
LastDistToOrigin := DistToOrigin;
end;
end;
if FirstPt <> nil then
begin
FirstPath := GetNetPathByP1P2(nil, FirstPt^);//777
Path := FirstPath;
PrevPath := nil;
PrevPt := FirstPt;
while Path <> nil do
begin
// áûâàåò ïîäâèñàåò
// ñì. çàäà÷ó: https://app.asana.com/0/388690353475548/876171867625289
// ïðè òàêîé êîíôèãóðàöèè ñòåí (âàæíî ãäå êàêîé íîä ðàñïîëîæåí) - https://prnt.sc/l90su0
// ïîýòîìó êîñòûëü - íî æåëàòåëüíî ïåðåäåëàòü ïðîáåæêó ïî êîíòóðó
// âñå îäíî Result â true òîëüêî åñëè Angle90Count = 4
if Angle90Count > 4 then
break;
if PrevPath <> nil then
begin
pc := PrevPt;
pi := Path.OtherPoint(pc);
pj := PrevPath.OtherPoint(pc);
Angle := Abs(RadToDeg(GetRadOf2Lines(pi^, pc^, pj^)));
Angle := CorrectAngle(Angle, 90);
if Abs(Angle - 90) < 1 then
Angle90Count := Angle90Count + 1
else
begin
Angle90Count := 5;
Break; //// BREAK ////
end;
// Åñëè ïîëíîñòþ îáîøëè êîíòóð - ïðèøëè íà ïåðâûé ñåãìåíò, òî çàâåðøàåì ïîèñê óãëîâ
if Path = FirstPath then
Break; //// BREAK ////
end;
// Èùåì ñëåä. ñåãìåíò
PrevPath := Path;
if PrevPt = Path.p1 then
begin
PrevPt := Path.p2;
Path := GetNetPathByP1P2(Path, Path.p2^)
end
else if PrevPt = Path.p2 then
begin
PrevPt := Path.p1;
Path := GetNetPathByP1P2(Path, Path.p1^)
end
else
Path := nil;
end;
Result := Angle90Count = 4;
end;
{for i := 0 to Paths.Count - 1 do
begin
PathI := TNetPath(Paths[i]);
for j := i+1 to Paths.Count - 1 do
begin
PathJ := TNetPath(Paths[j]);
pc := PathI.GetConnectedPoint(PathJ);
if pc <> nil then
begin
pi := PathI.OtherPoint(pc);
pj := PathJ.OtherPoint(pc);
Angle := Abs(RadToDeg(GetRadOf2Lines(pi^, pc^, pj^)));
Angle := CorrectAngle(Angle);
if Abs(Angle - 90) < 0.1 then
Angle90Count := Angle90Count + 1
else
begin
Angle90Count := 5;
Break; //// BREAK ////
end;
//pj
//if
end;
end;
end;
Result := Angle90Count = 4;}
end;
end;
Procedure TNet.ModifySelection(mm: TModifyMode; value: Integer);
var
i: Integer;
PathList: TList;
SlPath: TNetPath;
begin
inherited;
{if SelPath <> nil then
begin
case mm of
//mmPenColor : Color := value;
mmPenWidth: SelPath.FPathWidth := value;
mmPenStyle: SelPath.FPathStyle := TPenstyle(value);
mmBrushStyle: SelPath.FBrushStyle := value;
mmBrushColor : SelPath.FBrushColor := value;
//mmRowStyle : RowStyle := value;
end;
end;}
PathList := FSelection;
if SelType = stStruct then
PathList := Paths;
for i := 0 to PathList.Count - 1 do
begin
SlPath := TNetPath(PathList[i]);
if Paths.IndexOf(SlPath) <> -1 then
case mm of
mmPenColor : SlPath.FColor := value;
mmPenWidth: SlPath.FPathWidth := value;
mmPenStyle: SlPath.FPathStyle := TPenstyle(value);
mmBrushStyle: SlPath.FBrushStyle := value;
mmBrushColor : SlPath.FBrushColor := value;
//mmRowStyle : RowStyle := value;
end;
end;
end;
function TNet.MoveJoinedPoints(ADeltaX, ADeltaY: Double; AFromSaved: Boolean): Boolean;
var
i: integer;
pt, srcPt: PDoublePoint;
RelType: Integer;
Path: TNetPath;
sign: integer;
begin
Result := false;
if FJoinedMovePoints.Count = FJoinedMovePointsDirections.Count then
begin
for i := 0 to FJoinedMovePoints.Count - 1 do
begin
pt := FJoinedMovePoints[i];
srcPt := pt;
// Åñëè ñìåùåíèå îòíîñèòåëüíî èñõîäíîé ïîçèöèè
if AFromSaved then
srcPt := GetSavedPtByPoint(pt);
if srcPt <> nil then
begin
RelType := Integer(FJoinedMovePointsDirections[i]);
sign := 0;
if RelType = crtDirect then
sign := 1
else if RelType = crtReverse then
sign := -1;
pt^.x := srcPt^.x + ADeltaX*sign;
pt^.y := srcPt^.y + ADeltaY*sign;
//if RelType = crtDirect then
//begin
// pt^.x := srcPt^.x + ADeltaX;
// pt^.y := srcPt^.y + ADeltaY;
//end
//else if RelType = crtReverse then
//begin
// pt^.x := srcPt^.x + ADeltaX*(-1);
// pt^.y := srcPt^.y + ADeltaY*(-1);
//end;
end;
end;
Result := FJoinedMovePoints.Count > 0;
end;
if Not AFromSaved and (FJoinedMovePaths.Count = FJoinedMovePathsDirections.Count) then
begin
for i := 0 to FJoinedMovePaths.Count - 1 do
begin
Path := TNetPath(FJoinedMovePaths[i]);
RelType := Integer(FJoinedMovePathsDirections[i]);
sign := 0;
if RelType = crtDirect then
sign := 1
else if RelType = crtReverse then
sign := -1;
Path.p1^.x := Path.p1^.x + ADeltaX*sign;
Path.p1^.y := Path.p1^.y + ADeltaY*sign;
Path.p2^.x := Path.p2^.x + ADeltaX*sign;
Path.p2^.y := Path.p2^.y + ADeltaY*sign;
end;
if Not Result then
Result := FJoinedMovePaths.Count > 0;
end;
if Result and Assigned(FOnMoveJoinedPoints) then
begin
FOnMoveJoinedPoints(Self);
SetModified; //03.02.2012 ResetRegion;
end;
end;
procedure TNet.RotateAllNiche;
var
i,j:Integer;
Path: TNetPath;
Door: TNetDoor;
begin
for i := 0 to Paths.Count - 1 do
begin
Path := TNetPath(Paths[i]);
for j := 0 to Path.Doors.Count - 1 do
begin
Door := TNetDoor(Path.Doors[j]);
if Door.DoorObjType = dotNiche then
Door.FRotation := Door.FRotation xor 1;
end;
end;
end;
//procedure TNet.RestorePointsFromSaved;
//var
// i: integer;
//begin
// if Points.Count = FSavedPoints.Count then
// for i := 0 to Points.Count - 1 do
// PDoublePoint(Points[i])^ := PDoublePoint(FSavedPoints[i])^;
//end;
procedure TNet.SaveScaledPoints;
begin
SavePointsToList(FSavedScaledPoints);
end;
procedure TNet.SavePoints;
//var
// i: Integer;
// pt: PDoublePoint;
begin
//ClearSavedPoints;
//for i := 0 to Points.Count - 1 do
//begin
// GetMem(pt, SizeOf(TDoublePoint));
// pt^ := PDoublePoint(Points[i])^;
// FSavedPoints.Add(pt);
//end;
SavePointsToList(FSavedPoints);
end;
procedure TNet.SavePointsToList(AList: TList);
var
i: Integer;
pt: PDoublePoint;
begin
ClearPointsList(AList);
for i := 0 to Points.Count - 1 do
begin
GetMem(pt, SizeOf(TDoublePoint));
pt^ := PDoublePoint(Points[i])^;
AList.Add(pt);
end;
end;
procedure TNet.SelectAllPaths;
begin
FSelPtIdx := -1;
FSelection.Clear;
FSelection.Assign(Paths);
end;
function TNet.SelectNextPathByPt(x,y: Double): Boolean;
var
i, ResIdx: Integer;
Path: TNetPath;
begin
Result := false;
ResIdx := -1;
for i := SelIndex to Paths.Count - 1 do
//for i := Paths.Count - 1 downto SelIndex do
begin
if i >= 0 then
begin
Path := TNetPath(Paths[i]);
if Path.IsPointIn(x, y) then
begin
SelectPath(i+1);
ResIdx := i;
Result := true;
Break; //// BREAK ////
end;
end;
end;
//if ResIdx <> -1 then
//begin
// // Ñìåùàåì âñå ñ íà÷àëà â êîíåö, ÷òîáû ResIdx áûë íóëåâîé
// for i := 0 to ResIdx - 1 do
// Paths.Move(0, Paths.Count - 1);
// SelectPath(1);
// Result := true;
//end;
end;
function TNet.SelectNextPointByPt(x,y: Double): Boolean;
var
i: Integer;
Path: TNetPath;
begin
Result := false;
for i := (FSelPtIdx + 1) to Points.Count - 1 do
begin
if i >= 0 then
begin
//if EQDP(PDoublePoint(Points[i])^, DoublePoint(x, y)) then
if PointNear(PDoublePoint(Points[i])^, DoublePoint(x, y)) then
begin
SelectPt(PDoublePoint(Points[i]));
Result := true;
Break; //// BREAK ////
end;
end;
end;
end;
procedure TNet.SelectPt(APt: PDoublEPoint);
begin
FSelPtIdx := Points.IndexOf(APt);
SelIndex := 0;
FSelection.Clear;
end;
procedure TNet.SelectPath(AIndex: Integer; AllowMultisel: Boolean=false);
var
Path: TNetPath;
begin
FSelPtIdx := -1;
SelIndex := AIndex;
SelType := stPath;
if AIndex = 0 then
FSelection.Clear
else
begin
// Åñëè íå ìíîæåñòâåííîå âûäåëåíèå, òî î÷èùàåì ñïèñîê âûäåëåííûõ
if Not AllowMultisel or Not (ssCtrl in GGlobalShiftState) then
FSelection.Clear;
Path := TNetPath(Paths[SelIndex-1]);
if FSelection.IndexOf(Path) = -1 then
FSelection.Add(Path);
end;
end;
procedure TNet.SetMapScale(AMapScale: Double);
begin
if Assigned(FOnSetScale) then
FOnSetScale(Self, MapScale, AMapScale);
MapScale := AMapScale;
end;
procedure TNet.SetPathsHidden(AHidden: Boolean);
var
i: integer;
begin
for i := 0 to Paths.Count - 1 do
TNetPath(Paths[i]).FIsHidden := AHidden;
end;
procedure TNet.SetPointID(APoint: PDoublePoint; AID: Integer);
var
PointIndex: Integer;
begin
PointIndex := Points.IndexOf(APoint);
if PointIndex <> -1 then
FPointIDs[PointIndex] := Pointer(AID);
end;
{//24.05.2012
function TNet.GetRoomConture: TDoublePointArr;
var
i: integer;
p, basep: TDoublePoint;
NextPath: TNetPath;
Done: Boolean;
PIndex: integer;
begin
try
Done := False;
p := FindStartConturePPoint;
basep := p;
PIndex := 0;
SetLength(Result, 0);
NextPath := nil;
while not Done do
begin
NextPath := GetNetPathByP1P2(NextPath, p);
if NextPath <> nil then
begin
SetLength(Result, Length(Result) + 1);
Result[PIndex] := p;
if EQDP(NextPath.p1^, p) then
p := NextPath.p2^
else if EQDP(NextPath.p2^, p) then
p := NextPath.p1^;
if EQDP(p, basep) then
Done := True;
PIndex := PIndex + 1;
end
else
begin
SetLength(Result, Length(Result) + 1);
Result[PIndex] := p;
Done := True;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TNet.GetRoomConture', E.Message);
end;
end;}
function TNet.GetRoomConture(aPaths: TList): TDoublePointArr;
var
i: integer;
p, basep: PDoublePoint;
PrevPt, OtherPt, PrevOtherPt: PDoublePoint;
NextPath, PrevPath: TNetPath;
Done: Boolean;
PIndex: integer;
pSide, pOtherSide: Integer;
PrevPSide: Integer;
ptrPerpendP: PDoublePoint;
PerpendP1: TDoublePoint;
PerpendP2: TDoublePoint;
AddedPt: Boolean;
ArcPoints: TDoublePointArr;
// Tolik 23/08/2018 --
TmpPath: tNetPath;
//
function GetPerpendPtBySide(aPath: TNetPath; aSide: Integer): PDoublePoint;
begin
Result := nil;
if aSide = 1 then
begin
if aPath.epl1 <> nil then
Result := aPath.epl1
else
if aPath.epr1 <> nil then
Result := aPath.epr1;
end
else if aSide = 2 then
begin
if aPath.epl2 <> nil then
Result := aPath.epl2
else
if aPath.epr2 <> nil then
Result := aPath.epr2;
end;
end;
procedure AddPtToRes(aPt: PDoublePoint);
var
CanAdd: Boolean;
begin
CanAdd := true;
if PIndex > 0 then
CanAdd := EQDP(Result[PIndex-1], aPt^) = false;
if CanAdd then
begin
SetLength(Result, Length(Result) + 1);
Result[PIndex] := aPt^;
PIndex := PIndex + 1;
end;
end;
procedure AddPointsByPerpend(aPath: TNetPath; aSide: Integer; aPerpendPt: PDoublePoint; aDesc: Boolean);
var
AddPoints: TDoublePointArr;
SidePt: PDoublePoint;
MPtFrom, MPtTo: TDoublePoint;
PtFromProjected: TDoublePoint;
ptFrom, ptTo: PDoublepoint;
begin
Setlength(AddPoints, 0);
// Îïðåäåëÿåì òî÷êó, ñ êîòîðîé îïðåäåëåí aPerpendPt
SidePt := aPath.GetPointByPerpend(aPerpendPt);
if SidePt <> nil then
begin
ptFrom := aPath.GetPointBySide(aSide);
ptTo := aPath.GetPointBySide(GetOtherSide(aSide));
if (ptFrom <> nil) and (ptTo <> nil) then
begin
if aSide = 1 then
begin
MPtFrom := MPoint(aPath.el1, aPath.er1);
MPtTo := MPoint(aPath.el2, aPath.er2);
end
else if aSide = 2 then
begin
MPtFrom := MPoint(aPath.el2, aPath.er2);
MPtTo := MPoint(aPath.el1, aPath.er1);
end;
// Ïðîåöèðóåì ptFrom íà ëèíèþ MPtFrom, MPtTo
PtFromProjected := ptFrom^;
PointToLineByAngle(MPtFrom, MPtTo, PtFromProjected);
//SetLength(Result, Length(Result) + 2);
//if Not aDesc then
//begin
// Result[PIndex] := PtFromProjected;
// Result[PIndex+1] := MPtTo;
//end
//else
//begin
// Result[PIndex] := MPtTo;
// Result[PIndex+1] := PtFromProjected;
//end;
//PIndex := PIndex + 2;
if Not aDesc then
begin
AddPtToRes(@PtFromProjected);
AddPtToRes(@MPtTo);
end
else
begin
AddPtToRes(@MPtTo);
AddPtToRes(@PtFromProjected);
end;
end;
end;
end;
begin
try
Done := False;
NextPath := nil; // Tolik
{$if Defined(ES_GRAPH_SC)}
p := FindStartConturePoint(aPaths, @NextPath, @pSide);
{$else}
p := nil;
if aPaths.Count > 0 then
begin
p := TNetPath(aPaths[0]).P1;
if aPaths.Count = 1 then
NextPath := TNetPath(aPaths[0]);
pSide := 1;
if aPaths.Count > 1 then
begin
NextPath := TNetPath(aPaths[1]);
if ((CompareValue(NextPath.p1.x, p.x) <> 0) and (CompareValue(NextPath.p1.y, p.y) <> 0)) or
((CompareValue(NextPath.p2.x, p.x) <> 0) and (CompareValue(NextPath.p2.y, p.y) <> 0)) then
begin
p := TNetPath(aPaths[0]).P2;
Pside := 2;
end;
{if ((CompareValue(NextPath.p1.x, p.x) = 0) and (CompareValue(NextPath.p1.y, p.y) = 0)) then
pSide := 1
else
if ((CompareValue(NextPath.p2.x, p.x) = 0) and (CompareValue(NextPath.p2.y, p.y) = 0)) then
pSide := 2;}
end;
end;
{$ifEND}
if NextPath = nil then
exit; // Tolik 23/08/2018 -- íà âñÿêèé --
basep := p;
PrevPt := nil;
PrevOtherPt := nil;
PrevPath := nil;
PrevPSide := 0;
PIndex := 0;
SetLength(Result, 0);
//23.05.2012 NextPath := nil;
while not Done and (p <> nil) do
begin
if NextPath <> nil then
begin
pOtherSide := GetOtherSide(pSide);
OtherPt := NextPath.GetPointBySide(pOtherSide);
// Åñëè äðóãàÿ òî÷êà ñåãìåíòà - ýòî ïðåäûäóùàÿ òî÷êà, òî îïðåäåëÿåì ñ íåå òî÷êè ïî ïåðïåíäèêóëÿðó
if OtherPt = PrevPt then
begin
//ptrPerpendP := GetPerpendPtBySide(PrevPath, GetOtherSide(PrevPSide));
//if ptrPerpendP <> nil then
// AddPointsByPerpend(PrevPath, GetOtherSide(PrevPSide), ptrPerpendP, false)
ptrPerpendP := GetPerpendPtBySide(NextPath, pOtherSide);
if ptrPerpendP <> nil then
AddPointsByPerpend(NextPath, pOtherSide, ptrPerpendP, false)
else
begin
ptrPerpendP := GetPerpendPtBySide(NextPath, pSide);
if ptrPerpendP <> nil then
AddPointsByPerpend(NextPath, pSide, ptrPerpendP, true)
end;
end
else if PrevPt = nil then
begin
ptrPerpendP := GetPerpendPtBySide(NextPath, pOtherSide);
ptrPerpendP := GetPerpendPtBySide(NextPath, pSide);
end;
{if p = PrevOtherPt then
begin
ptrPerpendP := GetPerpendPtBySide(PrevPath, PrevPSide);
if ptrPerpendP <> nil then
AddPointsByPerpend(PrevPath, PrevPSide, ptrPerpendP, false)
else
begin
ptrPerpendP := GetPerpendPtBySide(NextPath, pSide);
if ptrPerpendP <> nil then
AddPointsByPerpend(PrevPath, PrevPSide, ptrPerpendP, false)
end;
end;}
end;
if (p = basep) and (PrevPt <> nil) then
Done := True;
if Not Done then
begin
AddedPt := false;
SetLength(Result, Length(Result) + 1);
//28.05.2012 Result[PIndex] := p^;
//Result[PIndex] := p^;
if NextPath.isArc then
begin
//DxfMode16 := true;
DxfMode32 := true;
try
NextPath.FillArcPointsByEndPoints(ArcPoints, NextPath.p1, NextPath.p2, false);
finally
//DxfMode16 := false;
DxfMode32 := false;
end;
if Length(ArcPoints) > 2 then
begin
SetLength(Result, Length(Result) + Length(ArcPoints));
// Ïåðâóþ è ïîñëåäíþþ òî÷êè ïðîïóñêàåì
for i := 0 to Length(ArcPoints) - 1 do
if p = NextPath.p2 then
Result[i+PIndex] := ArcPoints[Length(ArcPoints)-i-1]
else
Result[i+PIndex] := ArcPoints[i];
end;
PIndex := PIndex + Length(ArcPoints);
Result[PIndex] := p^;
AddedPt := true;
end;
//else
//if PrevPath <> nil then
// if PrevPath.isArc then
// begin
// Result[PIndex] := p^;
// AddedPt := true;
// end;
if Not AddedPt then
begin
if pSide = 1 then
Result[PIndex] := MPoint(NextPath.a1, NextPath.b1) //MPoint(NextPath.r1, NextPath.l1)
else if pSide = 2 then
Result[PIndex] := MPoint(NextPath.a2, NextPath.b2) //MPoint(NextPath.r2, NextPath.l2)
else // Íà âñÿêèé ñëó÷àé
Result[PIndex] := p^;
AddedPt := true;
end;
PIndex := PIndex + 1;
PrevPath := NextPath;
PrevPSide := pSide;
PrevOtherPt := OtherPt;
NextPath := GetNextNetPathByP1P2(aPaths, NextPath, p);
if NextPath <> nil then
begin
if NextPath.isArc then
Result[PIndex-1] := p^;
PrevPt := p;
if NextPath.p1 = p then
begin
p := NextPath.p2;
pSide := 2;
end
else if NextPath.p2 = p then
begin
p := NextPath.p1;
pSide := 1;
end;
end
else
Done := True;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TNet.GetRoomConture', E.Message);
end;
end;
function TNet.GetRoomSCSConture(aPaths: TList=nil): TDoublePointArr; // Tolik 27/06/2018 --
var i: Integer;
begin
end;
{//24.05.2012
function TNet.GetRoomInnerConture: TDoublePointArr;
var
i: integer;
p, r, basep: TDoublePoint;
PrevPath, NextPath: TNetPath;
Done: Boolean;
PIndex: integer;
begin
try
Done := False;
p := FindStartConturePPoint;
basep := p;
PIndex := 0;
SetLength(Result, 0);
PrevPath := nil;
NextPath := nil;
while not Done do
begin
NextPath := GetNetPathByP1P2(PrevPath, p);
if NextPath <> nil then
begin
SetLength(Result, Length(Result) + 1);
if EQDP(NextPath.p1^, p) then
begin
Result[PIndex] := NextPath.r1;
p := NextPath.p2^;
end
else if EQDP(NextPath.p2^, p) then
begin
Result[PIndex] := NextPath.r2;
p := NextPath.p1^;
end;
if EQDP(p, basep) then
Done := True;
PIndex := PIndex + 1;
PrevPath := NextPath;
end
else
begin
SetLength(Result, Length(Result) + 1);
if EQDP(PrevPath.p1^, p) then
begin
Result[PIndex] := PrevPath.r1;
end
else if EQDP(PrevPath.p2^, p) then
begin
Result[PIndex] := PrevPath.r2;
end;
Done := True;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TNet.GetRoomInnerConture', E.Message);
end;
end;}
function TNet.GetRoomInnerConture: TDoublePointArr;
var
i: integer;
p, r, basep: TDoublePoint;
PrevPath, NextPath: TNetPath;
Done: Boolean;
PIndex: integer;
begin
try
Done := False;
p := FindStartConturePPoint;
basep := p;
PIndex := 0;
SetLength(Result, 0);
PrevPath := nil;
NextPath := nil;
while not Done do
begin
NextPath := GetNetPathByP1P2(PrevPath, p);
if NextPath <> nil then
begin
SetLength(Result, Length(Result) + 1);
if EQDP(NextPath.p1^, p) then
begin
Result[PIndex] := NextPath.ip1^;
p := NextPath.p2^;
end
else if EQDP(NextPath.p2^, p) then
begin
Result[PIndex] := NextPath.ip2^;
p := NextPath.p1^;
end;
if EQDP(p, basep) then
Done := True;
PIndex := PIndex + 1;
PrevPath := NextPath;
end
else
begin
SetLength(Result, Length(Result) + 1);
if EQDP(PrevPath.p1^, p) then
begin
Result[PIndex] := PrevPath.ip1^;
end
else if EQDP(PrevPath.p2^, p) then
begin
Result[PIndex] := PrevPath.ip2^;
end;
Done := True;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TNet.GetRoomInnerConture', E.Message);
end;
end;
{//24.05.2012
function TNet.GetRoomOuterConture: TDoublePointArr;
var
i: integer;
p, l, basep: TDoublePoint;
PrevPath, NextPath: TNetPath;
Done: Boolean;
PIndex: integer;
begin
try
Done := False;
p := FindStartConturePPoint;
basep := p;
PIndex := 0;
SetLength(Result, 0);
PrevPath := nil;
NextPath := nil;
while not Done do
begin
NextPath := GetNetPathByP1P2(NextPath, p);
if NextPath <> nil then
begin
SetLength(Result, Length(Result) + 1);
Result[PIndex] := p;
if EQDP(NextPath.p1^, p) then
begin
Result[PIndex] := NextPath.l1;
p := NextPath.p2^;
end
else if EQDP(NextPath.p2^, p) then
begin
Result[PIndex] := NextPath.l2;
p := NextPath.p1^;
end;
if EQDP(p, basep) then
Done := True;
PIndex := PIndex + 1;
PrevPath := NextPath;
end
else
begin
SetLength(Result, Length(Result) + 1);
if EQDP(PrevPath.p1^, p) then
begin
Result[PIndex] := PrevPath.l1;
end
else if EQDP(PrevPath.p2^, p) then
begin
Result[PIndex] := PrevPath.l2;
end;
Done := True;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TNet.GetRoomOuterConture', E.Message);
end;
end;
}
function TNet.GetRoomOuterConture: TDoublePointArr;
var
i: integer;
p, l, basep: TDoublePoint;
PrevPath, NextPath: TNetPath;
Done: Boolean;
PIndex: integer;
begin
try
Done := False;
p := FindStartConturePPoint;
basep := p;
PIndex := 0;
SetLength(Result, 0);
PrevPath := nil;
NextPath := nil;
while not Done do
begin
NextPath := GetNetPathByP1P2(NextPath, p);
if NextPath <> nil then
begin
SetLength(Result, Length(Result) + 1);
Result[PIndex] := p;
if EQDP(NextPath.p1^, p) then
begin
Result[PIndex] := NextPath.op1^;
p := NextPath.p2^;
end
else if EQDP(NextPath.p2^, p) then
begin
Result[PIndex] := NextPath.op2^;
p := NextPath.p1^;
end;
if EQDP(p, basep) then
Done := True;
PIndex := PIndex + 1;
PrevPath := NextPath;
end
else
begin
SetLength(Result, Length(Result) + 1);
if EQDP(PrevPath.p1^, p) then
begin
Result[PIndex] := PrevPath.op1^;
end
else if EQDP(PrevPath.p2^, p) then
begin
Result[PIndex] := PrevPath.op2^;
end;
Done := True;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TNet.GetRoomOuterConture', E.Message);
end;
end;
function TNet.GetFloorConture: TDoublePointArr;
var
i: integer;
// 2011-05-10
p1, p2, p, r, basep: TDoublePoint;
NextPath: TNetPath;
Done: Boolean;
PIndex: integer;
SCSCompon: TSCSComponent;
wall_h1, wall_h2: double;
j: integer;
ArcPointArray: T3DPointArray;
TempArr: T3DPointArray;
begin
try
Done := False;
// 2011-05-10
r := FindStartContureRPoint;
basep := r;
//p := FindStartConturePPoint;
//basep := p;
wall_h1 := 0; //#From Oleg#
wall_h2 := 0;
PIndex := 0;
SetLength(Result, 0);
NextPath := nil;
while not Done do
begin
// 2011-05-10
NextPath := GetNetPathByR1R2(NextPath, r);
//NextPath := GetNetPathByP1P2(NextPath, p);
if NextPath <> nil then
begin
SCSCompon := nil;
SCSCompon := GetArchObjByCADObj(NextPath);
if not assigned(SCSCompon) then
exit;
wall_h1 := SCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
if wall_h1 < FFloorDelta then
wall_h1 := FFloorDelta;
// 2011-05-10
r.z := wall_h1;
SetLength(Result, Length(Result) + 1);
Result[PIndex] := r;
//p.z := wall_h1;
//SetLength(Result, Length(Result) + 1);
//Result[PIndex] := p;
if NextPath.isArc then
begin
SetLength(TempArr, 2);
// 2011-05-10
TempArr[0] := NextPath.r1;
TempArr[1] := NextPath.r2;
//TempArr[0] := NextPath.p1^;
//TempArr[1] := NextPath.p2^;
{
if EQDP(NextPath.r1, r) then
begin
TempArr[0] := r;
TempArr[1] := NextPath.r2;
end
else if EQDP(NextPath.r2, r) then
begin
TempArr[0] := NextPath.r1;
TempArr[1] := r;
end;
}
{
TempArr[0] := r;
if EQDP(NextPath.r1, r) then
TempArr[1] := NextPath.r2
else if EQDP(NextPath.r2, r) then
TempArr[1] := NextPath.r1;
}
//TempArr[0] := p;
// if EQDP(NextPath.p1^, p) then
// TempArr[1] := NextPath.p2^
// else if EQDP(NextPath.p2^, p) then
// TempArr[1] := NextPath.p1^;
ArcPointArray := GetArcWallPointsAll(TempArr, NextPath);
if Length(ArcPointArray) > 2 then
begin
// 2011-05-10
if EQDP(ArcPointArray[0], r) then
//if EQDP(ArcPointArray[0], p) then
begin
for j := 1 to Length(ArcPointArray) - 2 do
begin
PIndex := PIndex + 1;
SetLength(Result, Length(Result) + 1);
Result[PIndex] := ArcPointArray[j];
Result[PIndex].z := wall_h2;
end;
end
else
begin
for j := Length(ArcPointArray) - 2 downto 1 do
begin
PIndex := PIndex + 1;
SetLength(Result, Length(Result) + 1);
Result[PIndex] := ArcPointArray[j];
Result[PIndex].z := wall_h2;
end;
end;
end;
end;
// 2011-05-10
if EQDP(NextPath.r1, r) then
r := NextPath.r2
else if EQDP(NextPath.r2, r) then
r := NextPath.r1;
if EQDP(r, basep) then
{if EQDP(NextPath.p1^, p) then
p := NextPath.p2^
else if EQDP(NextPath.p2^, p) then
p := NextPath.p1^;
if EQDP(p, basep) then}
Done := True;
PIndex := PIndex + 1;
end
else
begin
// 2011-05-10
r.z := wall_h1;
SetLength(Result, Length(Result) + 1);
Result[PIndex] := r;
//p.z := wall_h1;
//SetLength(Result, Length(Result) + 1);
//Result[PIndex] := p;
Done := True;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TNet.GetFloorConture', E.Message);
end;
end;
function TNet.GetCeilingConture: TDoublePointArr;
var
i: integer;
// 2011-05-10
p1, p2, p, r, basep: TDoublePoint;
NextPath: TNetPath;
Done: Boolean;
PIndex: integer;
SCSCompon: TSCSComponent;
wall_h1, wall_h2: double;
j: integer;
ArcPointArray: T3DPointArray;
TempArr: T3DPointArray;
corner_side1, corner_side2: double;
Corners: TSCSComponents;
begin
try
Done := False;
// 2011-05-10
r := FindStartContureRPoint;
basep := r;
//p := FindStartConturePPoint;
//basep := p;
PIndex := 0;
SetLength(Result, 0);
NextPath := nil;
while not Done do
begin
// 2011-05-10
NextPath := GetNetPathByR1R2(NextPath, r);
//NextPath := GetNetPathByP1P2(NextPath, p);
if NextPath <> nil then
begin
SCSCompon := nil;
SCSCompon := GetArchObjByCADObj(NextPath);
if not assigned(SCSCompon) then
exit;
wall_h1 := SCSCompon.GetPropertyValueAsFloat(pnCoordZ);
wall_h2 := (wall_h1 + SCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta + FFCeilingDelta;
try
corner_side1 := wall_h2;
corner_side2 := wall_h2;
Corners := GetArchCornersForWall(SCSCompon);
corner_side1 := Corners[0].GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
if corner_side1 = 0 then
corner_side1 := wall_h2;
corner_side2 := Corners[1].GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
if corner_side2 = 0 then
corner_side2 := wall_h2;
except
end;
wall_h2 := corner_side1;
// 2011-05-10
r.z := wall_h2;
SetLength(Result, Length(Result) + 1);
Result[PIndex] := r;
//p.z := wall_h2;
//SetLength(Result, Length(Result) + 1);
//Result[PIndex] := p;
if NextPath.isArc then
begin
SetLength(TempArr, 2);
// 2011-05-10
TempArr[0] := NextPath.r1;
TempArr[1] := NextPath.r2;
{
if EQDP(NextPath.r1, r) then
begin
TempArr[0] := r;
TempArr[1] := NextPath.r2;
end
else if EQDP(NextPath.r2, r) then
begin
TempArr[0] := NextPath.r1;
TempArr[1] := r;
end;
}
{
TempArr[0] := r;
if EQDP(NextPath.r1, r) then
TempArr[1] := NextPath.r2
else if EQDP(NextPath.r2, r) then
TempArr[1] := NextPath.r1;
}
//TempArr[0] := NextPath.p1^;
//TempArr[1] := NextPath.p2^;
//02.06.2011 TempArr[0] := p;
//02.06.2011 if EQDP(NextPath.p1^, p) then
//02.06.2011 TempArr[1] := NextPath.p2^
//02.06.2011 else if EQDP(NextPath.p2^, p) then
//02.06.2011 TempArr[1] := NextPath.p1^;
ArcPointArray := GetArcWallPointsAll(TempArr, NextPath);
if Length(ArcPointArray) > 2 then
begin
// 2011-05-10
if EQDP(ArcPointArray[0], r) then
//if EQDP(ArcPointArray[0], p) then
begin
for j := 1 to Length(ArcPointArray) - 2 do
begin
PIndex := PIndex + 1;
SetLength(Result, Length(Result) + 1);
Result[PIndex] := ArcPointArray[j];
Result[PIndex].z := wall_h2;
end;
end
else
begin
for j := Length(ArcPointArray) - 2 downto 1 do
begin
PIndex := PIndex + 1;
SetLength(Result, Length(Result) + 1);
Result[PIndex] := ArcPointArray[j];
Result[PIndex].z := wall_h2;
end;
end;
end;
end;
// 2011-05-10
if EQDP(NextPath.r1, r) then
r := NextPath.r2
else if EQDP(NextPath.r2, r) then
r := NextPath.r1;
if EQDP(r, basep) then
{if EQDP(NextPath.p1^, p) then
p := NextPath.p2^
else if EQDP(NextPath.p2^, p) then
p := NextPath.p1^;
if EQDP(p, basep) then}
Done := True;
PIndex := PIndex + 1;
end
else
begin
// 2011-05-10
r.z := corner_side2; //wall_h2;
SetLength(Result, Length(Result) + 1);
Result[PIndex] := r;
//p.z := corner_side2; //wall_h2;
//SetLength(Result, Length(Result) + 1);
//Result[PIndex] := p;
Done := True;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TNet.GetCeilingConture', E.Message);
end;
end;
function TNet.GetNetPathByP1P2(aCurNetPath: TNetPath; p: TDoublePoint): TNetPath;
var
i: integer;
NetPath: TNetPath;
begin
Result := nil;
try
for i := 0 to Paths.Count - 1 do
begin
NetPath := TNetPath(Paths[i]);
if EQDP(NetPath.p1^, p) and (NetPath <> aCurNetPath) then
begin
Result := TNetPath(Paths[i]);
break;
end;
end;
if Result = nil then
begin
for i := 0 to Paths.Count - 1 do
begin
NetPath := TNetPath(Paths[i]);
if EQDP(NetPath.p2^, p) and (NetPath <> aCurNetPath) then
begin
Result := TNetPath(Paths[i]);
break;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TNet.GetNetPathByP1P2', E.Message);
end;
end;
function TNet.GetNextNetPathByP1P2(aPaths: TList; aCurNetPath: TNetPath; p: PDoublePoint; aSide: Pointer): TNetPath;
var
i: integer;
NetPath: TNetPath;
LookPaths: TList;
begin
Result := nil;
LookPaths := aPaths;
if LookPaths = nil then
LookPaths := Paths;
try
for i := 0 to LookPaths.Count - 1 do
begin
NetPath := TNetPath(LookPaths[i]);
if ((NetPath.p1 = p)or(NetPath.p2 = p)) and (NetPath <> aCurNetPath) then
begin
Result := TNetPath(LookPaths[i]);
if aSide <> nil then
Integer(aSide^) := 1;
break;
end;
end;
if Result = nil then
begin
for i := 0 to LookPaths.Count - 1 do
begin
NetPath := TNetPath(LookPaths[i]);
if (NetPath.p2 = p) and (NetPath <> aCurNetPath) then
begin
Result := TNetPath(LookPaths[i]);
if aSide <> nil then
Integer(aSide^) := 2;
break;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TNet.GetNextNetPathByP1P2', E.Message);
end;
end;
// 2011-05-10
function TNet.GetNetPathByR1R2(aCurNetPath: TNetPath; p: TDoublePoint): TNetPath;
var
i: integer;
NetPath: TNetPath;
begin
Result := nil;
try
for i := 0 to Paths.Count - 1 do
begin
NetPath := TNetPath(Paths[i]);
if EQDP(NetPath.r1, p) and (NetPath <> aCurNetPath) then
begin
Result := TNetPath(Paths[i]);
break;
end;
end;
if Result = nil then
begin
for i := 0 to Paths.Count - 1 do
begin
NetPath := TNetPath(Paths[i]);
if EQDP(NetPath.r2, p) and (NetPath <> aCurNetPath) then
begin
Result := TNetPath(Paths[i]);
break;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TNet.GetNetPathByP1P2', E.Message);
end;
end;
function TNet.FindStartConturePPoint(aPointPath: Pointer; aSide: Pointer): TDoublePoint;
var
i, j, PCount: integer;
NetPath: TNetPath;
// 2011-05-10
p, r: TDoublePoint;
pSide: Integer;
Wall: TSCSComponent;
begin
try
Result := PDoublePoint(Points[0])^;
for i := 0 to Points.Count - 1 do
begin
p := PDoublePoint(Points[i])^;
PCount := 0;
for j := 0 to Paths.Count - 1 do
begin
NetPath := TNetPath(Paths[j]);
pSide := 0;
if EQDP(NetPath.p1^, p) then
pSide := 1
else if EQDP(NetPath.p2^, p) then
pSide := 2;
if pSide <> 0 then
begin
Wall := nil;
Wall := GetArchObjByCADObj(NetPath);
if not Assigned(Wall) then
exit;
if Wall.IsLine <> ctArhWallDivision then
begin
PCount := PCount + 1;
if PCount = 1 then
begin
if (aPointPath <> nil) then
TNetPath(aPointPath^) := NetPath;
if aSide <> nil then
Integer(aSide^) := pSide;
end;
end;
end;
end;
// is Start Point
if PCount = 1 then
begin
Result := p;
exit;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TNet.FindStartConturePoint', E.Message);
end;
end;
function TNet.FindStartConturePoint(aPaths: TList; aPointPath: Pointer = nil; aSide: Pointer = nil): PDoublePoint;
var
i, j, PCount: integer;
NetPath: TNetPath;
p, r: PDoublePoint;
pSide: Integer;
Wall: TSCSComponent;
LookPaths: TList;
begin
try
Result := nil;
LookPaths := aPaths;
if LookPaths = nil then
LookPaths := Paths;
for i := 0 to Points.Count - 1 do
//for i := Points.Count - 1 downto 0 do
begin
p := Points[i];
PCount := 0;
for j := 0 to LookPaths.Count - 1 do
begin
NetPath := TNetPath(LookPaths[j]);
pSide := 0;
if NetPath.p1 = p then
pSide := 1
else if NetPath.p2 = p then
pSide := 2;
if pSide <> 0 then
begin
Wall := nil;
{$if Defined(ES_GRAPH_SC)} // Tolik 19/06/2018 - - åñëè ÃðàôÌîäóëü
Wall := GetArchObjByCADObj(NetPath);
if not Assigned(Wall) then
exit;
if Wall.IsLine <> ctArhWallDivision then
begin
Result := p;
if (aPointPath <> nil) then
TNetPath(aPointPath^) := NetPath;
if aSide <> nil then
Integer(aSide^) := pSide;
Break; //// BREAK ////
end;
{$else} // Tolik 20/06/2018 -- åñëè ÑÊÑ
Result := p;
if (aPointPath <> nil) then
TNetPath(aPointPath^) := NetPath;
if aSide <> nil then
Integer(aSide^) := pSide;
Break; //// BREAK ////
{$ifend}
end;
end;
if Result <> nil then
Break; //// BREAK ////
end;
except
on E: Exception do AddExceptionToLogEx('TNet.FindStartConturePoint', E.Message);
end;
end;
// 2011-05-10
function TNet.FindStartContureRPoint: TDoublePoint;
var
i, j, PCount: integer;
NetPath: TNetPath;
p, r: TDoublePoint;
Wall: TSCSComponent;
begin
try
//Result := PDoublePoint(Points[0])^;
Result := TNetPath(Paths[0]).r1;
for i := 0 to Points.Count - 1 do
begin
p := PDoublePoint(Points[i])^;
PCount := 0;
for j := 0 to Paths.Count - 1 do
begin
NetPath := TNetPath(Paths[j]);
if EQDP(NetPath.p1^, p) or EQDP(NetPath.p2^, p) then
begin
Wall := nil;
Wall := GetArchObjByCADObj(NetPath);
if not Assigned(Wall) then
exit;
if Wall.IsLine <> ctArhWallDivision then
begin
if EQDP(NetPath.p1^, p) then
r := NetPath.r1;
if EQDP(NetPath.p2^, p) then
r := NetPath.r2;
PCount := PCount + 1;
end;
end;
end;
// is Start Point
if PCount = 1 then
begin
Result := r;
exit;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TNet.FindStartContureRPoint', E.Message);
end;
end;
function TNet.GetRelatedNets(AllowPathCmpType: Integer=citNone; ASubRelNets: Boolean=false): TList;
var
i, j: Integer;
Path: TNetPath;
RelNets: TList;
RelNet: TNet;
begin
Result := TList.Create;
for i := 0 to Paths.Count - 1 do
begin
Path := TNetPath(Paths[i]);
RelNets := GetRelatedNetsByPoints(Path.p1, Path.p2);
if RelNets <> nil then
begin
for j := 0 to RelNets.Count - 1 do
begin
RelNet := TNet(RelNets[j]);
if Result.IndexOf(RelNet) = -1 then
Result.Add(RelNet);
end;
FreeAndNil(RelNets);
end;
end;
end;
function TNet.GetRelatedNetsByPoints(APoint1, APoint2: PDoublePoint; AllowPathCmpType: Integer=citNone;
ASubRelNets: Boolean=false): TList;
var
i, j, k: Integer;
Nets: TList;
Figure, InFigure: TFigure;
Net: TNet;
TempNet: TNet;
NetPath: TNetPath;
CanMergeNets: Boolean;
p: PDoublePoint;
NetAdded: Boolean;
Path: TNetPath;
IsRelated: Boolean;
PointPaths: TList;
AllNetList: TList;
NoAdded: TList;
JoinedNets: TList;
procedure AddNetToRes(ANet: TNet);
begin
if Result = nil then
Result := TList.Create;
Result.Add(ANet);
end;
procedure FindNetRelPaths(pt1, pt2: PDoublePoint; ANet: TNet; var ANetAdded: Boolean);
var
i: Integer;
CmpRes: Integer;
NetPath: TNetPath;
begin
for i := 0 to ANet.Paths.Count - 1 do
begin
NetPath := TNetPath(ANet.Paths[i]);
CmpRes := Self.CmpIntersectPaths(pt1,pt2, NetPath.p1, NetPath.p2);
if (CmpRes in [citAbsorb, citEntry]) or ((AllowPathCmpType <> citNone) and (CmpRes = AllowPathCmpType)) then
begin
if Not ANetAdded then
begin
AddNetToRes(ANet);
ANetAdded := true;
end;
if ANet.FRelatedPoints.IndexOf(NetPath.p1) = -1 then
ANet.FRelatedPoints.Add(NetPath.p1);
if ANet.FRelatedPoints.IndexOf(NetPath.p2) = -1 then
ANet.FRelatedPoints.Add(NetPath.p2);
if ANet.FRelatedObject = nil then
ANet.FRelatedObject := NetPath;
end;
end;
end;
procedure HandleNet(ANet: TNet);
var
j: Integer;
begin
Net := ANet;
CanMergeNets := true;
if Assigned(FOnMergeNetsQuery) then
FOnMergeNetsQuery(Self, Net, CanMergeNets);
if CanMergeNets then
begin
Net.FRelatedPoints.Clear;
Net.FRelatedObject := nil;
NetAdded := false;
for j := 0 to Net.Points.Count - 1 do
begin
p := PDoublepoint(Net.Points[j]);
if ((APoint1 <> nil) and PointNear(APoint1^, p^)) or ((APoint2 <> nil) and PointNear(APoint2^, p^)) then
begin
if Not NetAdded then
begin
AddNetToRes(Net);
NetAdded := true;
end;
Net.FRelatedPoints.Add(p);
end;
end;
if NetAdded then
begin
// Åñëè ïî äâóì òî÷êàì, òî ñìîòðèì ÿâëÿåòñÿ ëè ýòî ñåãìåíò
if (APoint1 <> nil) and (APoint2 <> nil) then
Net.FRelatedObject := Net.GetPathByNearPoints(APoint1, APoint2);
end;
// Èùåì ñåãìåíòû, êîòîðûå âõîäÿò â ñåãìåíò APoint1, APoint2
if (APoint1 <> nil) and (APoint2 <> nil) then
begin
FindNetRelPaths(APoint1, APoint2, Net, NetAdded);
end
else if APoint1 <> nil then
begin
if PointPaths = nil then
begin
PointPaths := TList.Create;
GetPathsOfKnot(APoint1, PointPaths);
end;
// èùåì â ýòîì îáúåêòå âòîðóþ òî÷êó íà ñåãìåíòàõ ïîäêëþ÷åííûõ ê ýòîé òî÷êå APoint1
//for j := 0 to PointPaths.Count - 1 do
//begin
// Path := TNetPath(PointPaths[j]);
// if Path.p1 = APoint1 then
// FindNetRelPaths(APoint1, Path.p2, Net, NetAdded)
// else if Path.p2 = APoint1 then
// FindNetRelPaths(APoint1, Path.p1, Net, NetAdded);
//end;
end;
if Not NetAdded and Assigned(NoAdded) then
NoAdded.Add(Net); //AddNetToRes(Net);
end;
end;
begin
Result := nil;
PointPaths := nil;
NoAdded := nil;
if ASubRelNets then
NoAdded := TList.Create;
{//07.05.2012
for i := 0 to TPowercad(Owner).Figures.Count - 1 do
begin
Figure := TFigure(TPowercad(Owner).Figures[i]);
if (Figure is TNet) and (Figure <> Self) then
HandleNet(TNet(Figure))
else
if Figure is TfigureGrp then
for j := 0 to TFigureGrp(Figure).InFigures.Count - 1 do
begin
InFigure := TFigure(TFigureGrp(Figure).InFigures[j]);
if (InFigure is TNet) and (InFigure <> Self) then
HandleNet(TNet(InFigure))
end;
end;}
Nets := GetAllNets(TPowercad(Owner));
for i := 0 to Nets.Count - 1 do
begin
Figure := TFigure(Nets[i]);
if Figure <> Self then
HandleNet(TNet(Figure))
end;
FreeAndNil(Nets);
if PointPaths <> nil then
PointPaths.Free;
//23.05.2011 - Äîáàâëÿåì TNet êîòîðûå ïî òî÷êàì ñâÿçàíû ñ òåìè ÷òî ïîïàëè â ðåçóëüòàò
if ASubRelNets and {Assigned(Result) and }Assigned(NoAdded) and (NoAdded.Count > 0) then
begin
{AllNetList := TList.Create;
if Assigned(Result) then
AllNetList.Assign(Result);
AllNetList.Insert(0, Self);
for i := 0 to AllNetList.Count - 1 do
begin
Net := TNet(AllNetList[i]);
for j := 0 to NoAdded.Count - 1 do
begin
TempNet := TNet(NoAdded[j]);
for k := 0 to TempNet.Points.Count - 1 do
begin
//if Net.GetPointByNear(PDoublePoint(TempNet.Points[k])^) <> nil then
if Not Assigned(Result) or (Result.IndexOf(TempNet) = -1) then
begin
AddNetToRes(TempNet);
TempNet := nil;
Break; //// BREAK ////
end;
end;
//if TempNet = nil then
// Break; //// BREAK ////
end;
end;
AllNetList.Free;}
if Assigned(FOnDefineJoinedNets) then
begin
AllNetList := TList.Create;
if Assigned(Result) then
AllNetList.Assign(Result);
AllNetList.Insert(0, Self);
JoinedNets := TList.Create;
FOnDefineJoinedNets(Self, AllNetList, NoAdded, JoinedNets);
for i := 0 to JoinedNets.Count - 1 do
AddNetToRes(TNet(JoinedNets[i]));
JoinedNets.Free;
AllNetList.Free;
end;
end;
if NoAdded <> nil then
NoAdded.Free;
end;
function TNet.GetRelatedPaths(APath: TNetPath; ACmpRes: TList=nil; AllowBySide: Boolean=false): TList;
var
//RelNets: TList;
//RelNet: TNet;
RelPath: TNetPath;
i, j: Integer;
Figure: TFigure;
Net: TNet;
CanMergeNets: Boolean;
CmpRes: Integer;
begin
Result := nil;
if ACmpRes <> nil then
ACmpRes.Clear;
if APath.isArc = false then
for i := 0 to TPowercad(Owner).Figures.Count - 1 do
begin
Figure := TFigure(TPowercad(Owner).Figures[i]);
if (Figure is TNet) and (Figure <> Self) then
begin
Net := TNet(Figure);
CanMergeNets := true;
if Assigned(FOnMergeNetsQuery) then
FOnMergeNetsQuery(Self, Net, CanMergeNets);
if CanMergeNets then
begin
//NetAdded := false;
for j := 0 to Net.Paths.Count - 1 do
begin
RelPath := TNetPath(Net.Paths[j]);
if RelPath.isArc = false then
begin
CmpRes := APath.CmpIntersectPath(RelPath);
if (CmpRes <> citNone) and ((CmpRes <> citSide) or AllowBySide) then
begin
if Result = nil then
Result := TList.Create;
Result.Add(RelPath);
if ACmpRes <> nil then
ACmpRes.Add(Pointer(CmpRes));
end;
end;
end;
end;
end;
end;
end;
function TNet.GetRelatedPoints(APoint: PDoublePoint; AOutPoints: TList=nil; APointNets: TList=nil): TList;
var
RelPt: PDoublePoint;
RelPtID: Integer;
i, j: Integer;
Figure: TFigure;
Net: TNet;
CanMergeNets: Boolean;
CmpRes: Integer;
begin
Result := nil;
if AOutPoints <> nil then
AOutPoints.Clear;
for i := 0 to TPowercad(Owner).Figures.Count - 1 do
begin
Figure := TFigure(TPowercad(Owner).Figures[i]);
if (Figure is TNet) then
begin
Net := TNet(Figure);
CanMergeNets := true;
if Assigned(FOnMergeNetsQuery) then
FOnMergeNetsQuery(Self, Net, CanMergeNets);
if CanMergeNets then
begin
for j := 0 to Net.Points.Count - 1 do
begin
RelPt := Net.Points[j];
if (RelPt <> APoint) and PointNear(APoint^, RelPt^) then
begin
RelPtID := Net.GetPointID(RelPt);
if RelPtID <> 0 then
begin
if Result = nil then
Result := Tlist.Create;
Result.Add(Pointer(RelPtID));
if AOutPoints <> nil then
AOutPoints.Add(RelPt);
if APointNets <> nil then
APointNets.Add(Net);
end;
end;
end;
end;
end;
end;
end;
function TNet.GetSelPathChild: TNetDoor;
var
Path: TNetPath;
begin
Result := nil;
Path := Self.SelPath;
if Path <> nil then
Result := Path.ActiveDoor;
end;
function TNet.PointToOrthogonal(APoint: PDoublePoint; x, y: Double; ANet: TNet; APointMoved: Pointer=nil): TDoublePoint;
var
RelatedPoints: TList; // Î÷êè íà äðóãèõ êîíöàõ ñåãìåíòîâ
RelNets: TList;
RelNet: TNet;
RelPath: TNetPath;
CanMergePaths: Boolean;
i, j: Integer;
Path: TNetPath;
p: PDoublePoint;
OrthX, OrthY: Pointer;
pFromI, pFromJ: PDoublePoint;
TempP: TDoublePoint;
//Angle: Double;
//dAndle: Double; // Ðàçíèöà óãëà
rAndle: Double;
NewP: TDoublePoint;
PreResPoint: TDoublePoint;
CurrDistance: Double;
LastDistance: Double;
LastDistanceX, LastDistanceY: Double;
Len_X, Len_Y: double;
PointMoved: Boolean;
PointMovedX, PointMovedY: Boolean;
MovingOrthogonal: Boolean;
PointInLine: Boolean;
Figure: TFigure;
Net: TNet;
CanMergeNets: Boolean;
function PointToRes(var AResult, ANewPoint: TDoublePoint; var ALastDist: Double; var AMovedStatus: Boolean): Boolean;
var
CurrDistance: Double;
begin
Result := false;
CurrDistance := GetLineLenght(DoublePoint(PreResPoint.x, PreResPoint.y), ANewPoint);
if (ALastDist = 0) or (CurrDistance < ALastDist) then
begin
ALastDist := CurrDistance;
AResult := ANewPoint;
AMovedStatus := true;
Result := true;
end;
end;
begin
Result := DoublePoint(x, y); //APoint^;
PreResPoint := DoublePoint(x, y);
PointMoved := false;
RelatedPoints := TList.Create;
// Ïîäòÿíóòü òî÷êó ê òî÷êå äðóãîãî TNet
RelNets := GetRelatedNetsByPoints(@PreResPoint, nil);
if RelNets <> nil then
begin
Path := ANet.GetPointPath(APoint);
if Path <> nil then
begin
for i := 0 to RelNets.Count - 1 do
begin
RelNet := TNet(RelNets[i]);
if RelNet.FRelatedPoints.Count > 0 then
begin
CanMergePaths := true;
if Assigned(FOnMergeNetsQuery) then
FOnMergeNetsQuery(Self, RelNet, CanMergePaths);
if CanMergePaths then
begin
p := PDoublePoint(RelNet.FRelatedPoints[0]);
RelPath := RelNet.GetPointPath(p);
if Assigned(FOnMergePathsQuery) then
FOnMergePathsQuery(Path, RelPath, CanMergePaths);
if CanMergePaths then
begin
PointMoved := true;
Result.x := p^.x;
Result.y := p^.y;
if APointMoved <> nil then
Boolean(APointMoved^) := PointMoved;
end;
end;
end;
end;
end;
RelNets.Free;
end;
if Not PointMoved then
begin
OrthX := nil;
OrthY := nil;
for i := 0 to ANet.Paths.Count - 1 do
begin
p := TNetPath(ANet.Paths[i]).SecondPoint(APoint);
if p <> nil then
begin
RelatedPoints.Add(p);
// Åñëè X èëè Y ðÿäîì ñ (X èëè Y) äðóãîé òî÷êè
if Abs(PreResPoint.x - p^.x) < 4 then
OrthX := @(p^.x)
else if Abs(PreResPoint.y - p^.y) < 4 then
OrthY := @(p^.y)
end;
end;
// Åñëè íàøëèñü êîîðäèíàòû äëÿ ïðÿìîãî óãëà
if (OrthX <> nil) and (OrthY <> nil) then
begin
PointMoved := true;
Result.x := Double(OrthX^);
Result.y := Double(OrthY^);
end;
end;
//OrthCorners := TList.Create;
//OrthCorners.Add(Pointer(0));
//OrthCorners.Add(Pointer(45));
//OrthCorners.Add(Pointer(90));
//OrthCorners.Add(Pointer(135));
//OrthCorners.Add(Pointer(180));
//OrthCorners.Add(Pointer(225));
//OrthCorners.Add(Pointer(270));
//OrthCorners.Add(Pointer(360));
if Not PointMoved then
begin
// Åñëè òî÷êà ïî÷òè âûðàâíèâàåò ïîäêëþ÷åííûå ëèíèè â îäíó äèàãîíàëü, òî ïîäãîíÿòü ïîä ýòó äèàãîíàëü
for i := 0 to ANet.Paths.Count - 1 do
begin
pFromI := TNetPath(ANet.Paths[i]).SecondPoint(APoint);
if pFromI <> nil then
for j := (i+1) to ANet.Paths.Count - 1 do
begin
pFromJ := TNetPath(ANet.Paths[j]).SecondPoint(APoint);
if pFromJ <> nil then
begin
// Èùåì ðàññòîÿíèå òî÷êè (x, y) îò äèàãîíàëè (pFromI pFromJ)
NewP := DoublePoint(x, y);
TempP := NewP;
PointToLine(pFromI^, pFromJ^, TempP.x, TempP.y);
// ðàññòîÿíèå îò òî÷êè äî ëèíèè
CurrDistance := GetLineLenght(NewP, TempP);
if (CurrDistance < 4) and isPointinLine(pFromI^, pFromJ^, TempP,1) then
begin
Result := TempP;
PointMoved := true;
end;
end;
end;
if PointMoved then
Break; //// BREAK ////
end;
end;
if Not PointMoved then
begin
// Åñëè òî÷êà ïî÷òè íà äðóãîì ñåãìåíòå, òîãäà åå ïîäòÿãèâàåì íà íåãî
//EmptyProcedure;
LastDistance := 0;
for i := 0 to TPowercad(Owner).Figures.Count - 1 do
begin
Figure := TFigure(TPowercad(Owner).Figures[i]);
if (Figure is TNet) and (Figure <> Self) and (Figure <> ANet.FSrcNet) then
begin
Net := TNet(Figure);
CanMergeNets := true;
if Assigned(FOnMergeNetsQuery) then
FOnMergeNetsQuery(Self, Net, CanMergeNets);
if CanMergeNets then
begin
for j := 0 to Net.Paths.Count - 1 do
begin
Path := TNetPath(Net.Paths[j]);
if Path.isArc = false then
begin
TempP := Result;
PointToLine(Path.p1^, Path.p2^, TempP.x, TempP.y);
CurrDistance := GetLineLenght(TempP, Result);
if (CurrDistance <= Path.Width) and ((LastDistance = 0) or (CurrDistance < LastDistance)) and
(isPointinLine(Path.p1^, Path.p2^, TempP, 1) or //23.05.2011
isPointinLine(Path.p1^, TempP, Path.p2^, 1) or //23.05.2011
isPointinLine(Path.p2^, TempP, Path.p1^, 1))
then
begin
//PointInLine := isPointinLine(Path.p1^, Path.p2^, TempP,1,0.1);
//TempP := Result;
//PointToLineByLen(Path.p1^, Path.p2^, TempP);
//PointInLine := isPointinLine(Path.p1^, Path.p2^, TempP,1,0.1);
LastDistance := CurrDistance;
Result := TempP;
PointMoved := true;
end;
end;
end;
end;
end;
end;
end;
if Not PointMoved then
begin
LastDistance := 0; // Äèñòàíöèÿ - íà ñêîëüêî íóæíî îòêëîíèòü òî÷êó
//LastDistanceX := 0;
//LastDistanceY := 0;
//PointMovedX := false;
//PointMovedY := false;
MovingOrthogonal := false;
for i := 0 to RelatedPoints.Count - 1 do
begin
p := RelatedPoints[i];
{TempP := p^;
TempP.x := TempP.x + 100; // Ñ ïðîâåðÿåìîé òî÷êè ïóñêàåì ïåðïåíäèêóëÿð ïî ãîðèçîíòàëå - äåëàåì âîîáðàæàåìóþ ëèíèþ
Angle := GetLinesAngle(APoint^, TempP, p^, TempP);
for j := 0 to OrthCorners.Count - 1 do
begin
dAndle := Integer(OrthCorners[j]) - Angle;
// Åñëè ìû ðÿäîì âîçëå íóæíîãî óãëà
//if Abs(dAndle) <= 5 then
begin
NewP := RotateDPoint(p^, APoint^, dAndle); // Êóäà íóæíî îòòÿíóòü APoint
CurrDistance := GetLineLenght(APoint^, NewP);
if CurrDistance <= 5 then
if (LastDistance = 0) or (LastDistance < CurrDistance) then
begin
LastDistance := CurrDistance;
Result := NewP;
GCADForm.sbView.Panels[2].Text :=
'OldAngle - '+FloatToStr(Angle)+
' Angle - '+FloatToStr(Integer(OrthCorners[j]))+
' Distance - '+FloatToStr(CurrDistance);
end;
end;
end;}
NewP := PreResPoint;
TempP := p^;
rAndle := 1 / tan(Integer(45) * pi / 180 / 2);
Len_X := {abs(TempP.x - Result.X); //14.10.2010} abs(TempP.x - PreResPoint.X);
Len_Y := {abs(TempP.y - Result.Y); //14.10.2010} abs(TempP.y - PreResPoint.Y);
// Åñëè âåäåì òî÷êó ïî âåðòèêàëüíîé, èëè ãîðèçîíòàëüíîé ïðÿìîé, òî îñòàâëÿåì íà ïðÿìîé
if (Len_X = 0) or (Len_Y = 0) then
begin
Result := PreResPoint;
PointMoved := true;
Break; //// BREAK ////
end;
// Åñëè òî÷êà ðÿäîì ñ îðòîãîíàëüíîé ëèíèåé
//if (Len_X < 5) or (Len_Y < 5) then
begin
if Len_X > Len_Y then
begin
if Len_X > rAndle * Len_Y then
NewP.y := TempP.Y
else
if Len_X < rAndle * Len_Y then
begin
if NewP.Y > TempP.Y then
NewP.Y := TempP.Y + Len_X
else
if NewP.Y < TempP.Y then
NewP.Y := TempP.Y - Len_X;
end;
//PointToRes(NewP, LastDistanceY, PointMovedY);
end
else
if (Len_X < Len_Y) then
begin
if Len_Y > rAndle * Len_X then
begin
if trunc(TempP.X) = 32 then
TempP.X := TempP.X;
NewP.X := TempP.X;
end
else
if Len_Y < rAndle * Len_X then
begin
if NewP.X > TempP.X then
NewP.X := TempP.X + Len_Y
else
if NewP.X < TempP.X then
NewP.X := TempP.X - Len_Y;
end;
//PointToRes(NewP, LastDistanceX, PointMovedX);
end;
//CurrDistance := GetLineLenght(DoublePoint(x, y), NewP);
//if (LastDistance = 0) or (CurrDistance < LastDistance) then
//begin
// LastDistance := CurrDistance;
// Result := NewP;
// PointMoved := true;
//end;
PointToRes(Result, NewP, LastDistance, PointMoved);
if PointMoved then
begin
EmptyProcedure;
end;
//if (Len_X < 5) or (Len_Y < 5) then
//begin
// MovingOrthogonal := true;
// LastDistance := 0;
// PointToRes(Result, NewP, LastDistance, PointMoved);
// //PreResPoint := NewP;
//end
//else
//if Not MovingOrthogonal then
// PointToRes(Result, NewP, LastDistance, PointMoved);
end;
end;
//PointMoved := PointMovedX or PointMovedY;
end;
//OrthCorners.Free;
RelatedPoints.Free;
end;
procedure TNet.SrvDropFComponID;
var
i: Integer;
begin
FComponID := 0;
for i := 0 to Paths.Count - 1 do
TNetPath(Paths[i]).FComponID := 0;
for i := 0 to FPointIDs.Count - 1 do
FPointIDs[i] := Pointer(0);
end;
{ TnetPath }
function TnetPath.ActiveDoor: TNetDoor;
begin
result := nil;
if (DoorIndex = -1) or (DoorIndex > Doors.Count-1) then
exit;
result := TNetDoor(Doors[DoorIndex]);
end;
function TNetPath.AreYou(xp1, xp2: PDoublePoint): Boolean;
begin
result := false;
result := ((p1 = xp1) and (p2 = xp2)) or ((p2 = xp1) and (p1 = xp2));
end;
procedure TnetPath.AddBezierPoints(var pArr: TDoublePointArr;
Direction: TPathDirection; IncFirst: Boolean);
begin
// Case wType of
// wtWall,wtOpen: begin
if isArc then
AddArcPoints(pArr,Direction,incFirst)
else
AddWallPoints(pArr,Direction,incFirst);
// end;
// wtOpen: begin
// AddOpenPoints(pArr,Direction,incFirst);
// AddWallPoints(pArr,Direction,incFirst);
// end;
// wtHalf: begin
// AddHalfPoints(pArr,Direction,incFirst);
// end;
// wtGlass: begin
// AddGlassPoints(pArr,Direction,incFirst);
// end;
// end;
end;
function TnetPath.AreYou(xp1, xp2: TDoublePoint): Boolean;
begin
result := false;
result := (EQDP(p1^,xp1) and EQDP(p2^,xp2)) or (EQDP(p2^,xp1) and EQDP(p1^,xp2));
end;
(*
procedure TnetPath.CalculatePoints(topZ,botZ:Double);
var
ww,outw: Double;
yp1,yp2,xp1,xp2: TDoublePOint;
//22.05.2012 door: TnetDoor;
i: Integer;
xPaths: TList;
toWall: Boolean;
begin
epl1 := nil;
epl2 := nil;
epr1 := nil;
epr2 := nil;
FPerpendDX := 0;
FPerpendDY := 0;
outw := 0;
if border then
outw := 1;
if isArc then
begin
ww := (Width / 2);
if Inverted then
begin
ArcCenter := GetArcCenter(p2^,p1^,ArcAng);
ArcA1 := GetRadOfLine(ArcCenter,p1^);
ArcA2 := GetRadOfLine(ArcCenter,p2^);
end
else
begin
ArcCenter := GetArcCenter(p1^,p2^,ArcAng);
ArcA2 := GetRadOfLine(ArcCenter,p1^);
ArcA1 := GetRadOfLine(ArcCenter,p2^);
end;
if ArcA2 = 0 then
ArcA2 := 2 * pi;
ArcRad := GetLineLenght(p1^,ArcCenter);
if Inverted then
ww := -ww;
OffsetPoint(p1^,ArcCenter,yp1,ww);
OffsetPoint(p2^,ArcCenter,yp2,ww);
l1 := yp1;
l2 := yp2;
el1 := l1; //14.04.2011
el2 := l2; //14.04.2011
a1 := yp1;
a2 := yp2;
OffsetPoint(p1^,ArcCenter,yp1,-ww);
OffsetPoint(p2^,ArcCenter,yp2,-ww);
r1 := yp1;
r2 := yp2;
er1 := r1; //14.04.2011
er2 := r2; //14.04.2011
b1 := yp1;
b2 := yp2;
OffsetPoint(p1^,ArcCenter,yp1,ww+1);
OffsetPoint(p2^,ArcCenter,yp2,ww+1);
Hl1 := yp1;
Hl2 := yp2;
OffsetPoint(p1^,ArcCenter,yp1,-(ww+1));
OffsetPoint(p2^,ArcCenter,yp2,-(ww+1));
Hr1 := yp1;
Hr2 := yp2;
end
else
begin
if wType in [wtWall,wtOpen] then
begin
ww := 0;
if WStyle = wsWall then
ww := (Width / 2);
GetParallelPoints(p1^,p2^,yp1,yp2,-ww);
l1 := yp1;
l2 := yp2;
el1 := l1; //14.04.2011
el2 := l2; //14.04.2011
a1 := yp1;
a2 := yp2;
GetParallelPoints(p1^,p2^,yp1,yp2,ww);
r1 := yp1;
r2 := yp2;
er1 := r1; //14.04.2011
er2 := r2; //14.04.2011
b1 := yp1;
b2 := yp2;
//ww := (Width / 2) + 1;
ww := 1;
if WStyle = wsWall then
ww := ww + (Width / 2);
GetParallelPoints(p1^,p2^,yp1,yp2,-ww);
Hl1 := yp1;
Hl2 := yp2;
GetParallelPoints(p1^,p2^,yp1,yp2,ww);
Hr1 := yp1;
Hr2 := yp2;
end
else
if wType in [wtGlass,wtHalf] then
begin
xp1 := p1^;
xp2 := p2^;
xPaths := TList.Create;
Net.GetPathsOfKnot(p1,xPaths);
ToWall := False;
for i := 0 to xpaths.Count - 1 do
begin
if (TnetPath(xPaths[i]).WType <> wtGlass) and
(TnetPath(xPaths[i]).WType <> wtHalf) and
(TnetPath(xPaths[i]).isArc = False) then
ToWall := True;
end;
if toWall then
xp1 := MPoint(p1^,p2^,Width/2);
xPaths.Clear;
Net.GetPathsOfKnot(p2,xPaths);
ToWall := False;
for i := 0 to xpaths.Count - 1 do
begin
if (TnetPath(xPaths[i]).WType <> wtGlass) and
(TnetPath(xPaths[i]).WType <> wtHalf) and
(TnetPath(xPaths[i]).isArc = False) then
ToWall := True;
end;
if toWall then
xp2 := MPoint(p2^,p1^,Width/2);
ww := Width / 2;
GetParallelPoints(xp1,xp2,yp1,yp2,-ww);
l1 := yp1;
l2 := yp2;
el1 := l1; //14.04.2011
el2 := l2; //14.04.2011
a1 := yp1;
a2 := yp2;
GetParallelPoints(xp1,xp2,yp1,yp2,ww);
r1 := yp1;
r2 := yp2;
er1 := r1; //14.04.2011
er2 := r2; //14.04.2011
b1 := yp1;
b2 := yp2;
ww := (Width / 2)+1;
GetParallelPoints(xp1,xp2,yp1,yp2,-ww);
Hl1 := yp1;
Hl2 := yp2;
GetParallelPoints(xp1,xp2,yp1,yp2,ww);
Hr1 := yp1;
Hr2 := yp2;
end;
SortDoors;
{//22.05.2012
for i := 0 to Doors.Count - 1 do
begin
Door := TnetDoor(Doors[i]);
Door.CalculatePoints(p1^,p2^);
end;}
CalculateDoorPoints(p1, p2);
end;
end;
*)
procedure TnetPath.CalculatePoints(topZ,botZ:Double);
var
ww,outw: Double;
yp1,yp2,xp1,xp2: TDoublePOint;
//22.05.2012 door: TnetDoor;
i: Integer;
xPaths: TList;
toWall: Boolean;
cp1, cp2: TDoublePoint;
begin
epl1 := nil;
epl2 := nil;
epr1 := nil;
epr2 := nil;
FPerpendDX := 0;
FPerpendDY := 0;
if FPointsOffset = 0 then
begin
cp1 := p1^;
cp2 := p2^;
end
else
GetParallelPoints(p1^,p2^, cp1,cp2, FPointsOffset);
outw := 0;
if border then
outw := 1;
if isArc then
begin
ww := (Width / 2);
if Inverted then
begin
ArcCenter := GetArcCenter(cp2,cp1,ArcAng);
ArcA1 := GetRadOfLine(ArcCenter,cp1);
ArcA2 := GetRadOfLine(ArcCenter,cp2);
end
else
begin
ArcCenter := GetArcCenter(cp1,cp2,ArcAng);
ArcA2 := GetRadOfLine(ArcCenter,cp1);
ArcA1 := GetRadOfLine(ArcCenter,cp2);
end;
if ArcA2 = 0 then
ArcA2 := 2 * pi;
ArcRad := GetLineLenght(cp1,ArcCenter);
if Inverted then
ww := -ww;
OffsetPoint(cp1,ArcCenter,yp1,ww);
OffsetPoint(cp2,ArcCenter,yp2,ww);
l1 := yp1;
l2 := yp2;
el1 := l1; //14.04.2011
el2 := l2; //14.04.2011
a1 := yp1;
a2 := yp2;
OffsetPoint(cp1,ArcCenter,yp1,-ww);
OffsetPoint(cp2,ArcCenter,yp2,-ww);
r1 := yp1;
r2 := yp2;
er1 := r1; //14.04.2011
er2 := r2; //14.04.2011
b1 := yp1;
b2 := yp2;
OffsetPoint(cp1,ArcCenter,yp1,ww+1);
OffsetPoint(cp2,ArcCenter,yp2,ww+1);
Hl1 := yp1;
Hl2 := yp2;
OffsetPoint(cp1,ArcCenter,yp1,-(ww+1));
OffsetPoint(cp2,ArcCenter,yp2,-(ww+1));
Hr1 := yp1;
Hr2 := yp2;
end
else
begin
if wType in [wtWall,wtOpen] then
begin
ww := 0;
if WStyle = wsWall then
ww := (Width / 2);
GetParallelPoints(cp1,cp2,yp1,yp2,-ww);
l1 := yp1;
l2 := yp2;
el1 := l1; //14.04.2011
el2 := l2; //14.04.2011
a1 := yp1;
a2 := yp2;
GetParallelPoints(cp1,cp2,yp1,yp2,ww);
r1 := yp1;
r2 := yp2;
er1 := r1; //14.04.2011
er2 := r2; //14.04.2011
b1 := yp1;
b2 := yp2;
//ww := (Width / 2) + 1;
ww := 1;
if WStyle = wsWall then
ww := ww + (Width / 2);
GetParallelPoints(cp1,cp2,yp1,yp2,-ww);
Hl1 := yp1;
Hl2 := yp2;
GetParallelPoints(cp1,cp2,yp1,yp2,ww);
Hr1 := yp1;
Hr2 := yp2;
end
else
if wType in [wtGlass,wtHalf] then
begin
xp1 := p1^;
xp2 := p2^;
xPaths := TList.Create;
Net.GetPathsOfKnot(p1,xPaths);
ToWall := False;
for i := 0 to xpaths.Count - 1 do
begin
if (TnetPath(xPaths[i]).WType <> wtGlass) and
(TnetPath(xPaths[i]).WType <> wtHalf) and
(TnetPath(xPaths[i]).isArc = False) then
ToWall := True;
end;
if toWall then
xp1 := MPoint(p1^,p2^,Width/2);
xPaths.Clear;
Net.GetPathsOfKnot(p2,xPaths);
ToWall := False;
for i := 0 to xpaths.Count - 1 do
begin
if (TnetPath(xPaths[i]).WType <> wtGlass) and
(TnetPath(xPaths[i]).WType <> wtHalf) and
(TnetPath(xPaths[i]).isArc = False) then
ToWall := True;
end;
if toWall then
xp2 := MPoint(p2^,p1^,Width/2);
ww := Width / 2;
GetParallelPoints(xp1,xp2,yp1,yp2,-ww);
l1 := yp1;
l2 := yp2;
el1 := l1; //14.04.2011
el2 := l2; //14.04.2011
a1 := yp1;
a2 := yp2;
GetParallelPoints(xp1,xp2,yp1,yp2,ww);
r1 := yp1;
r2 := yp2;
er1 := r1; //14.04.2011
er2 := r2; //14.04.2011
b1 := yp1;
b2 := yp2;
ww := (Width / 2)+1;
GetParallelPoints(xp1,xp2,yp1,yp2,-ww);
Hl1 := yp1;
Hl2 := yp2;
GetParallelPoints(xp1,xp2,yp1,yp2,ww);
Hr1 := yp1;
Hr2 := yp2;
end;
SortDoors;
{//22.05.2012
for i := 0 to Doors.Count - 1 do
begin
Door := TnetDoor(Doors[i]);
Door.CalculatePoints(p1^,p2^);
end;}
CalculateDoorPoints(@cp1, @cp2);
end;
end;
procedure TnetPath.ClearDoors;
var
door:TNetDoor;
i: Integer;
begin
try
For i := 0 to Doors.Count - 1 do
begin
door := TnetDoor(Doors[i]);
door.free;
end;
doors.clear;
except
// ShowMessage(CPowerCadMessage + 'TnetPath.ClearDoors');
end;
end;
function TnetPath.Connected(path: TnetPath): Boolean;
begin
result := false;
result := (p1 = path.p1) or (p2 = path.p2) or (p1 = path.p2) or (p2 = path.p1);
end;
procedure TnetPath.CopyFrom(sPath: TnetPath; AWithDoors: Boolean=true);
var
i: Integer;
sDoor,door: TnetDoor;
begin
Border := sPath.Border;
WType := sPath.wType;
WStyle := sPath.WStyle;
Width := sPath.Width;
isArc := sPath.isArc;
ArcAng := sPath.ArcAng;
ArcRad := sPath.ArcRad;
Inverted := sPath.Inverted;
Info := sPath.Info;
FPointsOffset := sPath.FPointsOffset;
FPerpendSide := sPath.FPerpendSide;
FPerpendDX := sPath.FPerpendDX;
FPerpendDY := sPath.FPerpendDY;
if AWithDoors then
begin
ClearDoors;
if WType = wtWall then
begin
for i := 0 to sPath.Doors.Count - 1 do
begin
sDoor := TnetDoor(sPath.Doors[i]);
door := TnetDoor.Create(sDoor.Start,sDoor.Width,sDoor.Len,sDoor.DoorObjType,net);
door.FComponID := sDoor.FComponID;
doors.Add(Door);
end;
end;
end;
end;
constructor TNetPath.Create(xp1, xp2: PDoublePoint; xBorder: Boolean; xNet: Tnet);
begin
inherited create;
Id := 0;// Tolik 21/12/2019 --
p1 := xp1;
p2 := xp2;
// Tolik 31/10/2019 --
if p1 <> nil then
p1.z := 0;
if p2 <> nil then
p2.z := 0;
//
p1H := -1;
p2H := -1;
Border := xBorder;
Empty1 := False;
Empty2 := False;
Region := 0;
DeadIdx := 0;
Net := xNet;
WType := GDefWallType; //13.04.2011 wtWall;
WStyle := wsWall; //15.04.2011
//WStyle := wsLine;
Width := Net.wallThick;
isArc := False;
ArcAng := pi/2;
Region := 0;
Doors := TList.Create;
DoorIndex := -1;
Broken := False;
Info := '';
FShowLength := True;
FPathStyle := psSolid;
FPathWidth := 1;
//FID := 0;
//FBrushColor := clBlack; //23.03.2013
//if FColor <> nil then
// FBrushColor := Integer(FColor)
//else
// FBrushColor := Net.Color;
FColor := clBlack; //nil;
if Net <> nil then
begin
FColor := Net.Color;
FBrushColor := Net.Color;
end
else
begin
FColor := clBlack;
FBrushColor := clBlack;
end;
FBrushStyle := -1; //17.03.2013
FComponID := 0;
FDeleting := false;
FDivedFrom := nil; //14.12.2010
FIsHidden := false; //21.04.2011
FIsInner := false;
FSelecting := false;
FOnAfterDiv := nil; //06.10.2010
FOnBeforeDiv := nil; //06.10.2010
FOnDblClick := nil;
FOnDelete := nil;
FOnGetHeight := nil;
FOnGetHeightOfPt := nil;
FOnGetPathCheckOverlapMargin := nil;
//FOnGetShowPathLength := nil;
//FOnGetShowPathTraceLength := nil;
FOnGetShowPathLengthType := nil;
FOnGetShowPathTraceLengthType := nil;
FOnMove := nil;
FOnSelect := nil;
ZeroMemory(@el1, SizeOf(TDoublePoint));
ZeroMemory(@el2, SizeOf(TDoublePoint));
ZeroMemory(@er1, SizeOf(TDoublePoint));
ZeroMemory(@er2, SizeOf(TDoublePoint));
FSrcPaths := TList.Create;
FSubRegions := TList.Create;
//18.05.2012 - Ïåðïåíäèêóëÿðíûå òî÷êè - ññûëêè íà el1,el2,er1,er2 ñâÿçàííîãî ñåãìåíòà
FPointsOffset := 0;
FPerpendSide := 0;
FPerpendDX := 0;
FPerpendDY := 0;
epl1 := nil;
epl2 := nil;
epr1 := nil;
epr2 := nil;
// Tolik
op1 := nil;
op2 := nil;
ip1 := nil;
ip2 := nil;
//26.03.2013
//if Net <> nil then
// if Net.FPathDivision <> nil then
// begin
// WStyle := Net.FPathDivision.WStyle;
// FColor := Net.FPathDivision.FColor;
// FBrushColor := Net.FPathDivision.FBrushColor;
// FBrushStyle := Net.FPathDivision.FBrushStyle;
// end;
GArchEngine.SetHandlersToObj(Self);
// Tolik 07/05/2019 --
if not GProjectChanged then
SetProjectChanged(True);
//
initialize; // Tolik 21/12/2019 --
end;
Procedure TNetPath.Initialize;
begin
if GCadForm <> nil then
if GCadForm.PCad <> nil then
begin
Inc(GCadForm.PCad.FLastFigureId);
id := GCadForm.PCad.FLastFigureId;
end;
end;
// Tolik 21/11/2019 - -
//function TnetPath.CreateArcRgn(DEngine: TPCDrawEngine): Integer;
function TnetPath.CreateArcRgn(DEngine: TPCDrawEngine): HRGN;
//
var
pArr: TDoublePointArr;
i: Integer;
//reg,reg1,reg2: Integer;
reg,reg1,reg2: HRGN;
rad1,rad2,ang1,ang2,ang3,ang4: Double;
begin
SetLength(pArr,4);
pArr[0] := ArcJoinA1;
pArr[1] := ArcJoinA1L;
pArr[2] := ArcJoinB1L;
pArr[3] := ArcJoinB1;
reg1 := Dengine.PolygonRegion(pArr);
pArr[0] := ArcJoinA2;
pArr[1] := ArcJoinA2L;
pArr[2] := ArcJoinB2L;
pArr[3] := ArcJoinB2;
reg2 := Dengine.PolygonRegion(pArr);
rad1 := GetLineLenght(ArcCenter,l1);
if Inverted then
begin
ang1 := GetRadOfLine(ArcCenter,l1);
ang2 := GetRadOfLine(ArcCenter,l2);
end
else
begin
ang1 := GetRadOfLine(ArcCenter,l2);
ang2 := GetRadOfLine(ArcCenter,l1);
end;
if ang2 = 0 then
ang2 := 2 * pi;
rad2 := GetLineLenght(ArcCenter,r1);
if Inverted then
begin
ang3 := GetRadOfLine(ArcCenter,r1);
ang4 := GetRadOfLine(ArcCenter,r2);
end
else
begin
ang3 := GetRadOfLine(ArcCenter,r2);
ang4 := GetRadOfLine(ArcCenter,r1);
end;
if ang4 = 0 then
ang4 := 2*pi;
reg := Dengine.CreateDoubleArcRegion(ArcCenter.x,ArcCenter.y,rad1,rad2,ang1,ang2,ang3,ang4);
CombineRgn(Reg,Reg,reg1,RGN_OR);
CombineRgn(Reg,Reg,reg2,RGN_OR);
DeleteObject(reg1);
DeleteObject(reg2);
Result := reg;
end;
class function TnetPath.CreateFromStream(Stream: TStream; xNet: Tnet; aOldPlan: Boolean): TnetPath;
var
PathVersion: Byte;
index: Integer;
i,dCnt: integer;
door: TnetDoor;
xByte: Byte;
xDbl: Double;
begin
Result := nil;
Result := TnetPath.Create(nil, nil, False, xNet);
Result.Width := xNet.WallThick;
Stream.Read(PathVersion, 1);
Stream.Read(xByte, 1);
Result.Border := Bool(xByte);
Stream.Read(xByte, 1);
Result.FShowLength := Bool(xByte);
Stream.Read(xDbl, 8);
if xDbl = 0 then
xDbl := xNet.WallThick;
Result.Width := xDbl;
if not aOldPlan then
begin
Stream.Read(index, 4);
Result.FPathStyle := TPenStyle(Index);
Stream.Read(index, 4);
Result.FPathWidth := Index;
end;
Stream.Read(index, 4);
if (index > -1) and (index < (xNet.Points.Count)) then
begin
Result.p1 := xNet.Points[index];
// Tolik 04/09/2018 --
//Result.p1.z := -1;
if Result.p1 <> nil then
Result.p1.z := 0;
end;
Stream.Read(index, 4);
if (index > -1) and (index < (xNet.Points.Count)) then
begin
Result.p2 := xNet.Points[index];
// Tolik 04/09/2018 --
//Result.p1.z := -1;
if Result.p2 <> nil then
Result.p2.z := 0;
end;
if (not assigned(result.p1)) or (not assigned(result.p2)) then
begin
result.free;
result := nil;
exit;
end;
Stream.Read(xByte,1);
Result.Wtype := TWallType(xByte);
Stream.Read(xByte,1);
Result.isArc := BBool(xByte);
if (result.isarc) then
begin
Stream.Read(Result.ArcAng,8);
Stream.Read(xByte,1);
Result.Inverted := BBool(xByte);
end;
//25.05.2010
if PathVersion >= 2 then
begin
Stream.Read(Result.FComponID,4);
if PathVersion >= 3 then
begin
Stream.Read(xByte,1);
Result.WStyle := TWallStyle(xByte);
end;
if PathVersion >= 4 then //22.05.2012
Stream.Read(Result.FPerpendSide, 1);
if PathVersion >= 5 then
begin
Stream.Read(index, 4);
Result.FColor := index;
Stream.Read(xByte, 1);
// Tolik 21/12/2019 --
//Result.FBrushStyle := xByte;
if xByte = 255 then
Result.FBrushStyle := -1
else
Result.FBrushStyle := xByte;
//
Stream.Read(index, 4);
Result.FBrushColor := index;
end;
end;
Stream.Read(dCnt,4);
//15.04.2011
//if dcnt < 11 then
// begin
// for i := 1 to dcnt do
// begin
// Door := TnetDoor.CreateFromStream(Stream,Result);
// if assigned(Door) then
// begin
// Result.Doors.Add(Door);
// end;
// end;
// end
// else
// begin
// result.free;
// result := nil;
// exit;
// end;
//15.04.2011
for i := 1 to dcnt do
begin
Door := TnetDoor.CreateFromStream(Stream,Result);
if assigned(Door) then
Result.Doors.Add(Door);
end;
// Tolik 04/09/2018 --
if PathVersion >= 6 then
begin
{if Result.p1 <> nil then
Stream.Read(Result.p1.z, 8);
if Result.p2 <> nil then
Stream.Read(Result.p2.z, 8);}
Stream.Read(Result.p1H, 8);
Stream.Read(Result.p2H, 8);
end;
//
//GArchEngine.SetHandlersToObj(Result);
Result.AfterLoadProps;
end;
// Tolik 21/11/2019 --
//function TnetPath.CreateInRgn(DEngine: TPCDrawEngine): Integer;
function TnetPath.CreateInRgn(DEngine: TPCDrawEngine): HRGN;
//
begin
if not isArc then
begin
Result := CreateLinearRgn(DEngine);
CreateLinearSubRgns(DEngine);
end
else
begin
Result := CreateArcRgn(DEngine);
end;
end;
// Tolik 21/11/2019 --
//function TnetPath.CreateLinearRgn(DEngine: TPCDrawEngine): Integer;
function TnetPath.CreateLinearRgn(DEngine: TPCDrawEngine): HRGN;
//
var
{//24.03.2013
pArr:TPointArr;
i: Integer;
xx,yy,z:Double;
Points: TList;}
//reg: Integer;
reg: HRGN;
begin
{//24.03.2013
Points := TList.Create;
Points.Add(@l1);
Points.Add(@l2);
Points.Add(@r2);
Points.Add(@r1);
SetLength(pArr, 4);
for i := 0 to Points.Count - 1 do
begin
z := 0;
xx := PDoublePOint(Points[i]).x;
yy := PDoublePOint(Points[i]).y;
DEngine.ConvertPoint(xx,yy,z);
PArr[i] := Point(round(xx),round(yy));
end;
Result := Dengine.PolygonRegion(pArr);
Points.Clear;
Points.Add(@a1);
Points.Add(@a2);
Points.Add(@b2);
Points.Add(@b1);
SetLength(pArr,4);
for i := 0 to POints.Count - 1 do
begin
xx := PDoublePOint(Points[i]).x;
yy := PDoublePOint(Points[i]).y;
DEngine.ConvertPoint(xx,yy,z);
PArr[i] := Point(round(xx),round(yy));
end;
reg := Dengine.PolygonRegion(pArr);
CombineRgn(Result,Result,reg,RGN_OR);
DeleteObject(reg);
Points.Free;}
Result := CreatePolygonRgnByPoints(DEngine, @l1, @l2, @r2, @r1);
reg := CreatePolygonRgnByPoints(DEngine, @a1, @a2, @b2, @b1);
CombineRgn(Result, Result, reg,RGN_OR);
DeleteObject(reg);
end;
procedure TnetPath.CreateLinearSubRgns(DEngine:TPCDrawEngine);
var
i, DoorsLen: Integer;
xL1, xR1: TDoublePoint;
Door: TNetDoor;
reg, regSide: HRGN;
begin
for i := 0 to FSubRegions.Count - 1 do
DeleteObject(HGDIOBJ(FSubRegions.Items[i]));
FSubRegions.Clear;
if Doors.Count > 0 then
begin
xL1 := l1;
xR1 := r1;
for i := 0 to Doors.Count-1 do
begin
Door := TnetDoor(Doors[i]);
//da1 := Door.a1;
//da2 := Door.a2;
//db1 := Door.b1;
//db2 := Door.b2;
//Net.drawline(Dengine, xL1, da1, color, 1, s);
//Net.drawline(Dengine, xr1, db1, color, 1, s);
//Net.drawline(Dengine, xL1, da1, color, FPathWidth, FPathStyle);
//Net.drawline(Dengine, xr1, db1, color, FPathWidth, FPathStyle);
reg := CreatePolygonRgnByPoints(DEngine, @xL1, @Door.a1, @Door.b1, @xr1);
if i = 0 then
begin
// points side 1
//regSide := CreatePolygonRgnByPoints(DEngine, @a1, @b1, @Door.a1, @Door.b1);
//regSide := CreatePolygonRgnByPoints(DEngine, @a1, @b1, @r1, @l1);
regSide := CreatePolygonRgnByPoints(DEngine, @a1, @b1, @l1, @r1);
CombineRgn(reg, reg, regSide, RGN_OR);
DeleteObject(regSide);
end;
FSubRegions.Add(Pointer(reg));
xl1 := Door.a2;
xr1 := Door.b2;
end;
reg := CreatePolygonRgnByPoints(DEngine, @xL1, @xr1, @r2, @l2);
// points side 2
//regSide := CreatePolygonRgnByPoints(DEngine, @a2, @b2, @Door.a2, @Door.b2);
regSide := CreatePolygonRgnByPoints(DEngine, @a2, @b2, @r2, @l2);
//regSide := CreatePolygonRgnByPoints(DEngine, @a2, @b2, @l2, @r2);
CombineRgn(reg, reg, regSide, RGN_OR);
DeleteObject(regSide);
FSubRegions.Add(Pointer(reg));
end;
end;
procedure TnetPath.DeleteDoor;
var
Door: TnetDoor;
begin
if (DoorIndex > -1) and (DoorIndex < Doors.Count) then
begin
Door := TnetDoor(Doors[DoorIndex]);
//Doors.Remove(Door);
//Door.Free;
DeleteDoorObj(Door);
DoorIndex := -1;
end;
end;
destructor TnetPath.Destroy;
Var i: Integer; // Tolik 24/12/2019 --
begin
ClearDoors;
Doors.Free;
if Region <> 0 then // Tolik 21/11/2019 --
DeleteObject(Region);
// Tolik 24/12/2019 --
for i := 0 to FSubRegions.Count - 1 do
DeleteObject(HGDIOBJ(FSubRegions.Items[i]));
FSubRegions.Clear;
//
FreeAndNil(FSubRegions); //23.03.2013
FreeAndNil(FSrcPaths); //15.02.2011
inherited;
end;
procedure TNetPath.Draw(Dengine: TPCDrawEngine;Color:TColor);
var
s: Integer;
mp: TDoublePOint;
begin
//if FColor <> nil then
// Color := Integer(FColor);
//Tolik 02/11/2021 -- åñëè ïîðòèòü âõîäÿùèé öâåò, íå áóäåò ðèñîâàòü ñåðûì, åñëè ñëîé óñòàíîâëåí êàê ñåðûé
// Color := FColor;
//
if not IsClosed then
begin
if isArc then
begin
s := Style;
if (wType = wtOpen) then
begin
s := ord(psDot);
end;
DrawArc(DEngine,Color,s);
end
else
if (wType = wtOpen) then
begin
DrawOpen(Dengine,Color);
end
else
if (wType = wtWall) then
begin
if isRow then
color := clred;
DrawWall(Dengine,Color);
end
else
if (wType = wtGlass) then
begin
DrawGlass(Dengine,Color);
end
else
if (wType = wtHalf) then
begin
DrawHalf(Dengine,Color);
end;
end;
DrawDoors(Dengine,Color);
end;
procedure TnetPath.DrawArc(Dengine: TPCDrawEngine;Color:Tcolor; style:Integer);
var
rgn: HRGN;
rad1,rad2,ang1,ang2: Double;
px,py:TDoublePoint;
begin
rad1 := GetLineLenght(ArcCenter,l1);
if Inverted then
begin
ang1 := GetRadOfLine(ArcCenter,l1);
ang2 := GetRadOfLine(ArcCenter,l2);
end
else
begin
ang1 := GetRadOfLine(ArcCenter,l2);
ang2 := GetRadOfLine(ArcCenter,l1);
end;
if ang2 = 0 then
ang2 := 2 * pi;
Dengine.drawbezarc(ArcCenter.x,ArcCenter.y,rad1,ang1,ang2,color,1,style,0,0,0,rgn,px,py,true,0);
rad1 := GetLineLenght(ArcCenter,r1);
if Inverted then
begin
ang1 := GetRadOfLine(ArcCenter,r1);
ang2 := GetRadOfLine(ArcCenter,r2);
end
else
begin
ang1 := GetRadOfLine(ArcCenter,r2);
ang2 := GetRadOfLine(ArcCenter,r1);
end;
if ang2 = 0 then
ang2 := 2 * pi;
rgn := 1;
Dengine.drawbezarc(ArcCenter.x,ArcCenter.y,rad1,ang1,ang2,color,1,style,0,0,0,rgn,px,py,true,0);
DEngine.drawline(ArcJoinA1.x,ArcJoinA1.y,ArcJoinA1L.x,ArcJoinA1L.y,color,1,style,0);
DEngine.drawline(ArcJoinA2.x,ArcJoinA2.y,ArcJoinA2L.x,ArcJoinA2L.y,color,1,style,0);
DEngine.drawline(ArcJoinB1.x,ArcJoinB1.y,ArcJoinB1L.x,ArcJoinB1L.y,color,1,style,0);
DEngine.drawline(ArcJoinB2.x,ArcJoinB2.y,ArcJoinB2L.x,ArcJoinB2L.y,color,1,style,0);
if Empty1 and Net.EndDraw then
DEngine.drawline(a1.x,a1.y,b1.x,b1.y,Color,1,style,0);
if Empty2 and Net.EndDraw then
DEngine.drawline(a2.x,a2.y,b2.x,b2.y,Color,1,style,0);
ApplyStyle(Dengine, color); //17.03.2013
end;
procedure TnetPath.DrawGlass(Dengine: TPCDrawEngine;Color:TColor);
var
xp1,xp2: TDoublePoint;
w: Integer;
begin
xp1 := MPoint(l1,r1);
xp2 := mPoint(l2,r2);
if Style = ord(psSolid) then
w := 2
else
w := 1;
Net.drawline(Dengine,xp1,xp2,color,w,TPenStyle(style));
end;
procedure TnetPath.DrawHalf(Dengine: TPCDrawEngine;Color:TColor);
var
s: TPenStyle;
xp1,xp2: TDoublePoint;
begin
xp1 := MPoint(l1,r1);
xp2 := mPoint(l2,r2);
Net.drawline(Dengine,xp1,xp2,color,1,TPenStyle(Style));
end;
procedure TnetPath.DrawOpen(Dengine: TPCDrawEngine; Color:TColor);
var
s: TPenStyle;
begin
s := psDot;
Net.drawline(Dengine,a1,b1,color,1,s);
Net.drawline(Dengine,a2,b2,color,1,s);
Net.drawline(Dengine,a1,a2,color,1,s);
Net.drawline(Dengine,b1,b2,color,1,s);
end;
procedure TNetPath.DrawTrace(Dengine: TPCDrawEngine);
var
mp: TDoublePOint;
l: Double;
lText, utext: String;
aLength: string;
aText: string;
pt1, pt2: TDoublePoint;
TraceLen: Double;
ShowPathLengthType: TShowPathLengthType;
MainNet: TNet;
begin
if not IsClosed and Not FIsHidden then
begin
pt1 := p1^;
pt2 := p2^;
ShowPathLengthType := sltPoints;
if Assigned(FOnGetShowPathTraceLengthType) then
ShowPathLengthType := FOnGetShowPathTraceLengthType(Self);
//if Opath <> nil then
begin
case ShowPathLengthType of
sltInner:
if (ip1 <> nil) and (ip2 <> nil) then
begin
pt1 := ip1^;
//PointToLine(p1^, p2^, pt1.x, pt1.y);
pt2 := ip2^;
//PointToLine(p1^, p2^, pt2.x, pt2.y);
end;
sltOuter:
if (op1 <> nil) and (op2 <> nil) then
begin
pt1 := op1^;
//PointToLine(p1^, p2^, pt1.x, pt1.y);
pt2 := op2^;
//PointToLine(p1^, p2^, pt2.x, pt2.y);
end;
end;
end;
DEngine.Canvas.Pen.Mode:= pmXor;
DEngine.drawline(p1^.x, p1^.y, p2^.x, p2^.y, clLime, 1, ord(psSolid), 0);
mp := MPoint(p1^, p2^);
TraceLen := 0;
if IsArc then
TraceLen := GetArcLenByPoints(pt1, pt2, ArcCenter, Inverted)
else
TraceLen := GetLineLenght(pt1, pt2);
aLength := FormatFloat(ffMask, MetreToUOM(Net.GetLengthForShow(TraceLen))); //21.04.2011 FormatFloat(ffMask, MetreToUOM(Len));
if Net.WorldDim then
aText := GetUOMString(GCurrProjUnitOfMeasure)
else
aText := cCadClasses_Mes6;
Dengine.TraceText(mp, clLime, aLength + aText, 'Arial', 8);
//22.10.2010
if IsArc then
begin
DrawArc(DEngine, clLime, Ord(psSolid));
//DrawArcCenter(DEngine, clLime, Ord(psSolid));
// ëèíèè îò öåíòðàëüíîé òî÷êè äî òî÷åê ñåãìåíòà
DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p1^.x,p1^.y, clLime, 1, Ord(psSolid), 0);
DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p2^.x,p2^.y, clLime, 1, Ord(psSolid), 0);
end;
//13.05.2011 - çàïîìèíàåì îòðèñîâàííûå òî÷êè
//MainNet := nil;
//if Assigned(Net.FRelatedOwner) then
//begin
// if (Net.FRelatedOwner is TNet) then
// MainNet := TNet(Net.FRelatedOwner)
// else if (Net.FRelatedOwner is TPathTrace) {and Assigned(TPathTrace(Net.FRelatedOwner).Clone)} then
// begin
// if Assigned(TPathTrace(Net.FRelatedOwner).FRelatedOwner) then
// begin
// if TPathTrace(Net.FRelatedOwner).FRelatedOwner is TPathTrace then
// if Assigned(TPathTrace(TPathTrace(Net.FRelatedOwner).FRelatedOwner).Clone) then
// MainNet := TPathTrace(TPathTrace(Net.FRelatedOwner).FRelatedOwner).Clone;
// end
// else if Assigned(TPathTrace(Net.FRelatedOwner).Clone) then
// MainNet := TPathTrace(Net.FRelatedOwner).Clone;
// end
//end
//else
// MainNet := Net;
MainNet := Net.GetMainTraceNet;
if MainNet <> nil then
begin
MainNet.FDrawedPt1.Add(p1);
MainNet.FDrawedPt2.Add(p2);
end;
end;
end;
procedure TnetPath.DrawWall(Dengine: TPCDrawEngine;Color:TColor);
var
i: Integer;
door: TnetDoor;
xl1, xr1, da1, da2, db1, db2: TDoublePoint;
s: TPenStyle;
xp1, xp2, xp, mp: TDoublePoint;
ang: Double;
xlen: Double;
aLength: string;
aText: string;
procedure DrawPerpendicular(pp1, pp2: PDoublepoint);
begin
if (pp1 <> nil) and (pp2 <> nil) then
Net.drawline(Dengine, pp1^, pp2^, color, FPathWidth, FPathStyle);
end;
begin
s := TpenStyle(Style);
// Test
// FPathWidth := 3;
// FPathStyle := psDot;
if Net.FIsGroup and (Opath = nil) then
Color := clBLue;
if Doors.Count > 0 then
begin
xL1 := l1;
xR1 := r1;
for i := 0 to Doors.Count-1 do
begin
Door := TnetDoor(Doors[i]);
da1 := Door.a1;
da2 := Door.a2;
db1 := Door.b1;
db2 := Door.b2;
//Net.drawline(Dengine, xL1, da1, color, 1, s);
//Net.drawline(Dengine, xr1, db1, color, 1, s);
Net.drawline(Dengine, xL1, da1, color, FPathWidth, FPathStyle);
Net.drawline(Dengine, xr1, db1, color, FPathWidth, FPathStyle);
Net.drawline(Dengine, da1, db1, color, 1, s);
Net.drawline(Dengine, da2, db2, color, 1, s);
xl1 := da2;
xr1 := db2;
//xl1 := da1;
//xr1 := db1;
end;
if WStyle = wsWall then
begin
// =====
Net.drawline(Dengine, xL1, l2, color, FPathWidth, FPathStyle);
Net.drawline(Dengine, xr1, r2, color, FPathWidth, FPathStyle);
// =====
//18.05.2012 - Ïåðïåíäèêóëÿðíûå ëèíèè- åñëè ñåãìåíò òîíüøå ñâÿçàííîãî
//DrawPerpendicular(@xL1, epl1);
//DrawPerpendicular(@xr1, epr1);
DrawPerpendicular(@l1, epl1);
DrawPerpendicular(@r1, epr1);
DrawPerpendicular(@l2, epl2);
DrawPerpendicular(@r2, epr2);
end;
end
else
begin
if WStyle = wsWall then
begin
// =====
Net.drawline(Dengine, l1, l2, color, FPathWidth, FPathStyle);
Net.drawline(Dengine, r1, r2, color, FPathWidth, FPathStyle);
// =====
//18.05.2012 - Ïåðïåíäèêóëÿðíûå ëèíèè- åñëè ñåãìåíò òîíüøå ñâÿçàííîãî
DrawPerpendicular(@l1, epl1);
DrawPerpendicular(@r1, epr1);
DrawPerpendicular(@l2, epl2);
DrawPerpendicular(@r2, epr2);
end;
end;
if Net.ShowDims then
begin
xp1 := MPoint(a1, b1, 6.0);
xp2 := MPoint(a2, b2, 6.0);
xp := MPoint(xp1,xp2);
if EQD(xp1.x,xp2.x) then
Angle := 3 * (pi / 2)
else
if EQD(xp1.y, xp2.y) then
Angle := 0
else
Angle := GetRadOfLine(xp1, xp2);
aLength := FormatFloat(ffMask, MetreToUOM(Len));
if Net.WorldDim then
aText := GetUOMString(GCurrProjUnitOfMeasure)
else
aText := cCadClasses_Mes6;
if FShowLength then
DEngine.DrawCenteredText(xp, clBlack, aLength + aText, 'Tahoma', 3.0, Angle);
end;
if Net.ShowPathCenters then
begin
xp := MPoint(p1^,p2^);
Dengine.drawselectionpoint(xp.x, xp.y, xp.z, ptECircle, 1, clGray, false);
end;
if WStyle = wsWall then
begin
// =====
if Empty1 and Net.EndDraw then
Net.drawline(Dengine, a1, b1, color, FPathWidth, FPathStyle);
if Empty2 and Net.EndDraw then
Net.drawline(Dengine, a2, b2, color, FPathWidth, FPathStyle);
// =====
ApplyStyle(Dengine, color); //17.03.2013
end
else if WStyle = wsLine then
begin
Net.drawline(Dengine, p1^, p2^, color, FPathWidth, FPathStyle);
end;
if Info <> '' then
begin
xp := MPoint(p1^,p2^);
ang := GetRadOfLine(p1^,p2^);
if EQD(ang , pi) then
ang := 0;
if EQD(ang, 3 * pi / 2) then
ang := pi / 2;
if FShowLength then
DEngine.DrawCenteredText(xp, clBlack, Info, 'Verdana', 2.5, ang);
end;
end;
procedure TnetPath.Hatch(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
reg: HRGN;
color: TColor;
Door: TnetDoor;
xp1, xp2, xp: TDoublePoint;
Angle: Double;
aLength: string;
aText: string;
ShowPathLengthType: TShowPathLengthType;
begin
Door := ActiveDoor;
if Assigned(Door) then
begin
Color := clGreen;
if isGrayed then
Color := clSilver;
DEngine.FillRgn(Door.Region,Color,ord(bsFDiagonal));
end
else
begin
Color := clBlue;
if isGrayed then
Color := clSilver;
//25.03.2013 DEngine.FillRgn(Region,Color,ord(bsFDiagonal));
FillRegions(DEngine, Color, ord(bsFDiagonal));
//DEngine.FillRgn(Region, clMaroon,ord(bsCross));
if (not Net.ShowDims) then
begin
xp1 := MPoint(a1, b1, 6.0);
xp2 := MPoint(a2, b2, 6.0);
xp := MPoint(xp1,xp2);
if EQD(xp1.x,xp2.x) then
Angle := 3*(pi/2)
else
if EQD(xp1.y,xp2.y) then
Angle := 0
else
Angle := GetRadOfLine(xp1,xp2);
//15.04.2011 aLength := FormatFloat(ffMask, MetreToUOM(Len));
aLength := '';
//if Assigned(FOnGetShowPathLength) then
// aLength := FormatFloat(ffMask, MetreToUOM(FOnGetShowPathLength(Self)))
//else
// aLength := FormatFloat(ffMask, MetreToUOM(GetLenForShow(sltPoints)));
ShowPathLengthType := sltPoints;
if Assigned(FOnGetShowPathLengthType) then
ShowPathLengthType := FOnGetShowPathLengthType(Self);
aLength := FormatFloat(ffMask, MetreToUOM(GetLenForShow(ShowPathLengthType)));
if Net.WorldDim then
aText := GetUOMString(GCurrProjUnitOfMeasure)
else
aText := cCadClasses_Mes6;
if FShowLength then
DEngine.DrawCenteredText(xp, clBlack, aLength + aText, 'Tahoma', 3.0, Angle);
end;
//22.10.2010
if IsArc then
begin
DrawArcCenter(DEngine, clRed, Ord(psSolid));
//TPowerCad(Net.Owner).
//if (DragState <> dsMove) and (DragState <> dsLocate) then
begin
// Òî÷êà ïî öåíòðó
{Color := clGreen;
if isGrayed then
Color := clSilver;
DEngine.drawselectionpoint(ArcCenter.x, ArcCenter.y, ArcCenter.z, ptRect, 3, Color);
// ëèíèè îò öåíòðàëüíîé òî÷êè äî òî÷åê ñåãìåíòà
Color := clRed;
if isGrayed then
Color := Grayedcolor;
DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p1^.x,p1^.y, Color, 1, ord(psSolid), 0);
DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p2^.x,p2^.y, Color, 1, ord(psSolid), 0);
// Ëèíèÿ ìåæäó òî÷êàìè
DEngine.DrawLine(p1^.x,p1^.y, p2^.x,p2^.y, Color, 1, ord(psDot), 0);}
end;
end;
end;
end;
function TnetPath.ISClosed: Boolean;
begin
result := false;
result := EQDP(p1^,p2^);
end;
function TnetPath.isKnotIn(p: PDoublePoint): Integer;
begin
result := 0;
if (p = p1) then
result := 1
else
if (p=p2) then
result := 2
else
result := 0;
end;
function TnetPath.isKnotValIn(p: TDoublePoint): Integer;
begin
result := 0;
if EQDP(p,p1^) then
result := 1
else
if EQDP(p,p2^) then
result := 2
else
result := 0;
end;
function TnetPath.IsPointIn(x, y: Double; aSelect: Boolean=true): Boolean;
var
ipt: TPOint;
dx,dy,z: Double;
i: Integer;
Door: TnetDoor;
begin
Result := False;
if WStyle = wsLine then
result := isPointInLine(p1^,p2^,DoublePoint(x,y),1)
else
if (wType <> wtHalf) and assigned(net) and assigned(net.XDrawEngine) and (region <> 0) then
begin
dx := x;
dy := y;
z := 0;
net.XDrawEngine.ConvertPoint(dx,dy,z);
ipt := Point(round(dx),round(dy));
if aSelect then
begin
DoorIndex := -1;
for i := 0 to Doors.Count - 1 do
begin
Door := TnetDoor(Doors[i]);
if ptInRegion(Door.Region,ipt.x,ipt.Y) then
begin
result := True;
DoorIndex := i;
exit;
end;
end;
end;
result := ptInRegion(region,ipt.x,ipt.Y);
end
else
begin
result := isPointInLine(p1^,p2^,DoublePoint(x,y),1);
end;
end;
function TnetPath.IsPointOnLine(x, y: Double): Boolean;
begin
result := false;
result := isPointInLine(p1^, p2^, DoublePoint(x, y), 1);
end;
function TnetPath.Len: Double;
var
w: Double;
begin
result := 0;
w := width;
// Result := (GetLineLenght(p1^,p2^) - w) / 1000;
// if Net.WorldDim then
// Result := (Result * Net.MapScale);
Result := GetLenByPoints(p1^,p2^); //28.10.2010 GetLineLenght(p1^,p2^){ - w};
if Net.WorldDim then
Result := Result / 1000 * Net.MapScale
else
Result := Result / 10;
end;
procedure TnetPath.Move(dx, dy: Double);
begin
p1.x := p1.x + dx;
p1.y := p1.y + dy;
p2.x := p2.x + dx;
p2.y := p2.y + dy;
if Assigned(FOnMove) then
FOnMove(Self);
end;
procedure TnetPath.MoveDoor(delta: Double);
var
Door: TnetDoor;
begin
if (DoorIndex > -1) and (DoorIndex < Doors.Count) then
begin
Door := TnetDoor(Doors[DoorIndex]);
Door.Start := Door.Start + Delta;
end;
end;
function TnetPath.NewDoor(s, len: Double; aDoorObjType: TDoorObjType): TnetDoor;
begin
Result := nil;
if WType <> wtWall then
exit;
s := (abslen - len) /2;
s := s + (width / 2);
Result := TNetDoor.Create(s, width, len, aDoorObjType, net);
Doors.Add(Result);
end;
function TnetPath.OtherPoint(p: PDoublePoint): PDoublePoint;
begin
result := nil;
if (p = p1) then
result := p2
else
result := p1;
end;
function TnetPath.Overlaps(path: TnetPath): Boolean;
var
p: TDoublePoint;
a1,a2,a3,a4: Boolean;
MarginDelta: Double;
begin
result := false;
result := GetIntersectionPoint(p1^,p2^,path.p1^,path.p2^,p,false);
if not result then
begin
MarginDelta := 2;
if Assigned(FOnGetPathCheckOverlapMargin) then
FOnGetPathCheckOverlapMargin(Net, Self, Path, MarginDelta);
a1 := False;
a2 := false;
a3 := false;
a4 := false;
if isKnotIn(path.p1) = 0 then
a1:= isPointInLine(p1^,p2^,path.p1^,1, MarginDelta);
if isKnotIn(path.p2) = 0 then
a2 := isPointInLine(p1^,p2^,path.p2^,1, MarginDelta);
if Path.isKnotIn(p1) = 0 then
a3 := isPointInLine(path.p1^,path.p2^,p1^,1, MarginDelta);
if Path.isKnotIn(p2) = 0 then
a4 := isPointInLine(path.p1^,path.p2^,p2^,1, MarginDelta);
result := a1 or a2 or a3 or a4;
end;
end;
function TnetPath.PosType: TPosType;
var
dx,dy: Double;
begin
dx := abs(p1.x - p2.x);
dy := abs(p1.y - p2.y);
if dx > dy then
result := ptHorizontal
else
if dx < dy then
result := ptVertical
else
result := ptAngular;
end;
procedure TnetPath.SetArcAng(ang: Double);
begin
ArcAng := ang;
end;
procedure TnetPath.SetShape(xArc: Boolean);
begin
isArc := xArc;
end;
procedure TnetPath.SetType(xType: TWallType);
begin
WType := xType;
end;
Function GetDoorStartValue(Obj:Pointer):Double;
begin
result := TnetDoor(Obj).Start;
end;
procedure TnetPath.SortDoors;
var
Door,door2: TnetDoor;
cnt: Integer;
index,i: Integer;
PathLen: Double;
begin
cnt := Doors.Count;
PathLen := AbsLen + Width;
if Cnt = 1 then
begin
Door := TnetDoor(Doors[0]);
if Door.Len > PathLen then
Door.Len := PathLen;
if Door.Start+Door.Len > PathLen-(Width/2) then
Door.Start := PathLen-(Width/2)-Door.Len;
end;
if cnt < 2 then
exit;
SortList(Doors,GetDoorStartValue);
for i := 0 to cnt - 2 do
begin
Door := TnetDoor(Doors[i]);
Door2 := TnetDoor(Doors[i + 1]);
if Door.Start+Door.Len > Door2.Start then
begin
Door2.Start := Door.Start+Door.Len+2;
end;
if Door.Start+Door.Len > PathLen-(Width/2) then
Door.Start := PathLen-(Width/2)-Door.Len;
if Door2.Start+Door2.Len > PathLen-(Width/2) then
Door2.Start := PathLen-(Width/2)-Door2.Len;
end;
end;
procedure TnetPath.UpdateRegion(Dengine:TPCDrawEngine);
var
i: Integer;
begin
if Region <> 0 then // Tolik 21/11/2019 --
DeleteObject(Region);
Region := CreateInRgn(Dengine);
For i := 0 to Doors.Count-1 do
begin
TNetDoor(Doors[i]).UpdateRegion(Dengine);
end;
end;
// Tolik 04/09/2018 -- ñòàðàÿ çàêîììåí÷åíà, ñìîòðè íèæå
procedure TnetPath.WriteToStream(Stream: TStream);
var
PathVersion: Byte;
index: Integer;
i: integer;
door: TnetDoor;
b: Byte;
begin
//PathVersion := 1; //25.05.2010
//PathVersion := 2; //15.04.2011
//PathVersion := 3; //22.05.2012
//PathVersion := 4; //17.03.2013
//PathVersion := 5; // 04/09/2018
PathVersion := 6;
Stream.Write(PathVersion, 1);
Stream.Write(Byte(Border), 1);
Stream.Write(Byte(FShowLength), 1);
Stream.Write(Width, 8);
index := Ord(FPathStyle);
Stream.Write(index, 4);
index := FPathWidth;
Stream.Write(index, 4);
index := Net.Points.IndexOf(p1);
Stream.Write(index, 4);
index := Net.Points.IndexOf(p2);
Stream.Write(index, 4);
Stream.Write(Byte(Wtype),1);
Stream.Write(Byte(isArc),1);
if isArc then
begin
Stream.Write(ArcAng,8);
Stream.Write(Byte(Inverted),1);
end;
Stream.Write(FComponID, 4); //25.05.2010
Stream.Write(Byte(WStyle),1); //15.04.2011
Stream.Write(FPerpendSide, 1); //22.05.2012
Stream.Write(FColor, 4); //23.03.2013
//Tolik 22/08/2019
//Stream.Write(Byte(FBrushStyle),1); //17.03.2013
// Tolik 21/12/2019 --
//b := FBrushStyle;
if FBrushStyle = -1 then
b := 255
else
b := FBrushStyle;
//
Stream.Write(b,1); //17.03.2013
//
Stream.Write(FBrushColor, 4); //23.03.2013
Stream.Write(Doors.Count,4);
for i := 0 to Doors.Count - 1 do
begin
Door := TNetDoor(Doors[i]);
Door.WriteToStream(Stream);
end;
// Tolik 04/09/2018 --
Stream.Write(p1H, 8);
Stream.Write(p2H, 8);
//
end;
{
procedure TnetPath.WriteToStream(Stream: TStream);
var
PathVersion: Byte;
index: Integer;
i: integer;
door: TnetDoor;
b: Byte;
begin
//PathVersion := 1; //25.05.2010
//PathVersion := 2; //15.04.2011
//PathVersion := 3; //22.05.2012
//PathVersion := 4; //17.03.2013
PathVersion := 5;
Stream.Write(PathVersion, 1);
Stream.Write(Byte(Border), 1);
Stream.Write(Byte(FShowLength), 1);
Stream.Write(Width, 8);
index := Ord(FPathStyle);
Stream.Write(index, 4);
index := FPathWidth;
Stream.Write(index, 4);
index := Net.Points.IndexOf(p1);
Stream.Write(index, 4);
index := Net.Points.IndexOf(p2);
Stream.Write(index, 4);
Stream.Write(Byte(Wtype),1);
Stream.Write(Byte(isArc),1);
if isArc then
begin
Stream.Write(ArcAng,8);
Stream.Write(Byte(Inverted),1);
end;
Stream.Write(FComponID, 4); //25.05.2010
Stream.Write(Byte(WStyle),1); //15.04.2011
Stream.Write(FPerpendSide, 1); //22.05.2012
Stream.Write(FColor, 4); //23.03.2013
Stream.Write(Byte(FBrushStyle),1); //17.03.2013
Stream.Write(FBrushColor, 4); //23.03.2013
Stream.Write(Doors.Count,4);
for i := 0 to Doors.Count - 1 do
begin
Door := TNetDoor(Doors[i]);
Door.WriteToStream(Stream);
end;
end; }
procedure TnetPath.AddArcPoints(var pArr: TDoublePointArr;
Direction: TPathDirection; IncFirst: Boolean);
var
rgn: HRGN;
rad1,rad2,ang1,ang2: Double;
px,py: TDoublePoint;
Points: T2DPointArray;
pCnt,oCnt,i,k: Integer;
reversed: Boolean;
begin
oCnt := Length(pArr);
if (Direction = ptL12) or (Direction = ptL21) then
begin
rad1 := GetLineLenght(ArcCenter,l1);
reversed := false;
if Inverted then
begin
ang1 := GetRadOfLine(ArcCenter,l1);
ang2 := GetRadOfLine(ArcCenter,l2);
reversed := (Direction = ptL21);
end
else
begin
ang1 := GetRadOfLine(ArcCenter,l2);
ang2 := GetRadOfLine(ArcCenter,l1);
reversed := (Direction = ptL12);
end;
if ang2 = 0 then
ang2 := 2 * pi;
BezierArcPoints(Points,ArcCenter.x,ArcCenter.y,rad1,ang1,ang2);
pCnt := Length(Points);
for i := 0 to Pcnt - 1 do
begin
if (i > 0) or (incFirst) then
begin
k := i;
if reversed then
k := pcnt - 1 - i;
oCnt := oCnt + 1;
SetLength(pArr,OCnt);
pArr[Ocnt-1] := DoublePoint(Points[k].X,Points[k].Y);
end;
end;
end
else
begin
rad1 := GetLineLenght(ArcCenter,r1);
reversed := false;
if Inverted then
begin
ang1 := GetRadOfLine(ArcCenter,r1);
ang2 := GetRadOfLine(ArcCenter,r2);
reversed := (Direction = ptR21);
end
else
begin
ang1 := GetRadOfLine(ArcCenter,r2);
ang2 := GetRadOfLine(ArcCenter,r1);
reversed := (Direction = ptR12);
end;
if ang2 = 0 then
ang2 := 2 * pi;
rgn := 1;
BezierArcPoints(Points,ArcCenter.x,ArcCenter.y,rad1,ang1,ang2);
pCnt := Length(Points);
for i := 0 to Pcnt - 1 do
begin
if (i > 0) or (incFirst) then
begin
k := i;
if reversed then
k := pcnt - 1 - i;
oCnt := oCnt + 1;
SetLength(pArr,OCnt);
pArr[Ocnt-1] := DoublePoint(Points[k].X,Points[k].Y);
end;
end;
end;
end;
procedure TnetPath.AddGlassPoints(var pArr: TDoublePointArr;
Direction: TPathDirection; IncFirst: Boolean);
begin
end;
procedure TnetPath.AddHalfPoints(var pArr: TDoublePointArr;
Direction: TPathDirection; IncFirst: Boolean);
begin
end;
procedure TnetPath.AddOpenPoints(var pArr: TDoublePointArr;
Direction: TPathDirection; IncFirst: Boolean);
begin
end;
procedure TnetPath.AddWallPoints(var pArr: TDoublePointArr;
Direction: TPathDirection; IncFirst: Boolean);
var
oCnt,pCnt: Integer;
begin
if incFirst then
pCnt := 4
else
pCnt := 3;
oCnt := Length(pArr);
pCnt := oCnt + pCnt;
SetLength(pArr,pCnt);
Case direction of
ptL12: begin
if incFirst then
pArr[pCnt-4] := L1;
pArr[pCnt-3] := L1;
pArr[pCnt-2] := L2;
pArr[pCnt-1] := L2;
end;
ptL21: begin
if incFirst then
pArr[pCnt-4] := L2;
pArr[pCnt-3] := L2;
pArr[pCnt-2] := L1;
pArr[pCnt-1] := L1;
end;
ptR12: begin
if incFirst then
pArr[pCnt-4] := R1;
pArr[pCnt-3] := R1;
pArr[pCnt-2] := R2;
pArr[pCnt-1] := R2;
end;
ptR21: begin
if incFirst then
pArr[pCnt-4] := R2;
pArr[pCnt-3] := R2;
pArr[pCnt-2] := R1;
pArr[pCnt-1] := R1;
end;
end;
end;
procedure TnetPath.AddEndLine(var pArr: TDoublePointArr;
Direction: TPathDirection);
var
pCnt,oCnt: Integer;
begin
pCnt := 3;
oCnt := Length(pArr);
pCnt := oCnt + pCnt;
SetLength(pArr,pCnt);
Case direction of
ptL12: begin
pArr[pCnt-3] := L2;
pArr[pCnt-2] := R2;
pArr[pCnt-1] := R2;
end;
ptL21: begin
pArr[pCnt-3] := L1;
pArr[pCnt-2] := R1;
pArr[pCnt-1] := R1;
end;
ptR12: begin
pArr[pCnt-3] := R2;
pArr[pCnt-2] := L2;
pArr[pCnt-1] := L2;
end;
ptR21: begin
pArr[pCnt-3] := R1;
pArr[pCnt-2] := L1;
pArr[pCnt-1] := L1;
end;
end;
end;
procedure TnetPath.DrawInnerCorners(DEngine: TPCDrawEngine; Color, Width,
Style: Integer);
var
xp1,xp2: TDoublePoint;
begin
if Dir = 2 then
begin
xp1 := isoTopL1;
xp2 := isoBotL1;
DEngine.drawline(xp1,xp2,color,Width,Style,0);
xp1 := isoTopL2;
xp2 := isoBotL2;
DEngine.drawline(xp1,xp2,color,Width,Style,0);
end
else
begin
xp1 := isoTopR1;
xp2 := isoBotR1;
DEngine.drawline(xp1,xp2,color,Width,Style,0);
xp1 := isoTopR2;
xp2 := isoBotR2;
DEngine.drawline(xp1,xp2,color,Width,Style,0);
end;
end;
procedure TnetPath.DrawOuterCorners(DEngine: TPCDrawEngine; Color, Width,
Style: Integer);
var
xp1,xp2: TDoublePoint;
begin
if Dir = 1 then
begin
xp1 := isoTopL1;
xp2 := isoBotL1;
DEngine.drawline(xp1,xp2,color,Width,Style,0);
xp1 := isoTopL2;
xp2 := isoBotL2;
DEngine.drawline(xp1,xp2,color,Width,Style,0);
end
else
begin
xp1 := isoTopR1;
xp2 := isoBotR1;
DEngine.drawline(xp1,xp2,color,Width,Style,0);
xp1 := isoTopR2;
xp2 := isoBotR2;
DEngine.drawline(xp1,xp2,color,Width,Style,0);
end;
end;
procedure TnetPath.DrawDoors(Dengine: TPCDrawEngine; Color: TColor);
var
i: Integer;
Door: TnetDoor;
begin
for i:= 0 to Doors.Count -1 do
begin
Door := TnetDoor(Doors[i]);
Door.Draw(Dengine,Color);
end;
end;
procedure TnetPath.IsometricDraw(Dengine: TPCDrawEngine; Color: TColor);
var
i: Integer;
rgn: HRGN;
bs: Integer;
begin
(*
for i := 0 to Length(FaceDraws)-1 do
begin
rgn := 1;
Dengine.drawpolygon(FaceDraws[i],Color,1,ord(psSOlid),clSilver,ord(bsClear),rgn);
if i = 0 then begin
Dengine.FillRgn(FaceRegions[i],clSilver,ord(bsSolid));
end;
end;
*)
end;
function TnetPath.AbsLen: Double;
begin
result := 0;
Result := (GetLineLenght(p1^,p2^) - Width);
end;
function TnetPath.PointToWall(var p: TdoublePoint; refP: TDoublePoint): Boolean;
var
ip: TDoublePoint;
begin
result := false;
if GetInterSectionPoint(p1^,p2^,p,refP,ip,True) then
begin
if IsPointIn(ip.x, ip.y, false) then //26.06.2012
begin
if not CheckPointForOtherNets(p) then
begin
p := ip;
result := True;
end;
end;
end;
end;
Procedure TnetPath.CalculateDoorPoints(dp1, dp2: PDoublePoint);
var
Door: TNetDoor;
i: Integer;
begin
for i := 0 to Doors.Count - 1 do
begin
Door := TnetDoor(Doors[i]);
Door.CalculatePoints(dp1^,dp2^);
end;
end;
procedure TnetPath.CalculateExternSnaps;
var
lL, lR: Double;
begin
lL := GetLineLenght(HL1,HL2);
lR := GetLineLenght(HR1,HR2);
HE1 := HL1;
HE2 := HL2;
if abs(lL - LR) > 1 then
begin
if lL > LR then
begin
HE1 := HR1;
HE2 := HR2;
PointToLine(Hl1,HL2,HE1.x,HE1.y);
PointToLine(Hl1,HL2,HE2.x,HE2.y);
end
else
begin
HE1 := HL1;
HE2 := HL2;
PointToLine(HR1,HR2,HE1.x,HE1.y);
PointToLine(HR1,HR2,HE2.x,HE2.y);
end;
end;
end;
function TnetPath.SnapToCorners(var x, y: Double; DotsPerMil: Double): Boolean;
var
d1,d2,d3,d4,d5,d6,d7,d8,d: Double;
p,pd: TDoublePoint;
snapDist: Double;
begin
result := false;
snapDist := 24/dotspermil;
p := DoublePoint(x,y);
d1 := GetLineLenght(l1,p);
d2 := GetLineLenght(l2,p);
d3 := GetLineLenght(r1,p);
d4 := GetLineLenght(r2,p);
d5 := GetDistToLine(l1,l2,p);
d6 := GetDistToLine(r1,r2,p);
d := d1;
pd := l1;
if d2 < d then
begin
d := d2;
pd := l2;
end;
if d3 < d then
begin
d := d3;
pd := r1;
end;
if d4 < d then
begin
d := d4;
pd := r2;
end;
if d5 < d then
begin
d := d5;
pd := DoublePoint(x,y);
PointToLine(l1, l2, pd.x, pd.y);
end;
if d6 < d then
begin
d := d6;
pd := DoublePoint(x,y);
PointToLine(r1, r2, pd.x, pd.y);
end;
if d < snapDist then
begin
x := pd.x;
y := pd.y;
result := true;
end;
end;
function TnetPath.SnapToKnots(var x, y: Double; DotsPerMil: Double; SnapLine:Boolean): Boolean;
var
d1,d2,d3,d4,d5,d6,d7,d8,d: Double;
p,pd: TDoublePoint;
snapDist: Double;
begin
result := false;
snapDist := 24 / dotspermil;
p := DoublePoint(x, y);
d1 := GetLineLenght(p1^, p);
d2 := GetLineLenght(p2^, p);
d3 := GetLineLenght(MPoint(p1^, p2^), p);
d := d1;
pd := p1^;
if d2 < d then
begin
d := d2;
pd := p2^;
end;
if d3 < d then
begin
d := d3;
pd := MPoint(p1^, p2^);
end;
if (d >= snapDist) and SnapLine then
begin
d := GetDistToLine(p1^, p2^,p);
pd := DoublePoint(x, y);
PointToLine(p1^, p2^, pd.x, pd.y);
end;
if d < snapDist then
begin
x := pd.x;
y := pd.y;
result := true;
end;
end;
function TnetPath.SnapToPipeLine(var x, y: Double;
DotsPerMil: Double): Boolean;
var
d1,d2,d3,d4,d5,d6,d7,d8,d: Double;
p,pd: TDoublePoint;
snapDist: Double;
begin
result := false;
snapDist := 24 / dotspermil;
p := DoublePoint(x, y);
d7 := GetDistToLine(hl1, hl2, p);
d8 := GetDistToLine(hr1, hr2, p);
if d7 > d8 then
begin
d := d8;
d := d8;
pd := DoublePoint(x, y);
PointToLine(hr1, hr2, pd.x, pd.y);
end
else
begin
d := d7;
pd := DoublePoint(x,y);
PointToLine(hl1,hl2,pd.x,pd.y);
end;
if (d < snapDist) (*and (d<>0)*) then
begin
x := pd.x;
y := pd.y;
result := true;
end;
end;
function TnetPath.SnapToPipeCorners(var x, y: Double; DotsPerMil: Double): Boolean;
var
d1,d2,d3,d4,d5,d6,d7,d8,d: Double;
p,pd: TDoublePoint;
snapDist: Double;
begin
result := false;
snapDist := 24/dotspermil;
p := DoublePoint(x,y);
d1 := GetLineLenght(hl1,p);
d2 := GetLineLenght(hl2,p);
d3 := GetLineLenght(hr1,p);
d4 := GetLineLenght(hr2,p);
d5 := GetLineLenght(he1,p);
d6 := GetLineLenght(he2,p);
d := d1;
pd := hl1;
if d2 < d then
begin
d := d2;
pd := hl2;
end;
if d3 < d then
begin
d := d3;
pd := hr1;
end;
if d4 < d then
begin
d := d4;
pd := hr2;
end;
if d5 < d then
begin
d := d5;
pd := he1;
end;
if d6 < d then
begin
d := d6;
pd := he2;
end;
if (d < snapDist) (*and (d<>0)*) then
begin
x := pd.x;
y := pd.y;
result := true;
end;
end;
function TnetPath.ForceSnapToPipeCorners(var x, y, dSnap: Double): Boolean;
var
d1,d2,d3,d4,d5,d6,d7,d8,d: Double;
p,pd: TDoublePoint;
begin
result := false;
p := DoublePoint(x,y);
d1 := GetLineLenght(hl1,p);
d2 := GetLineLenght(hl2,p);
d3 := GetLineLenght(hr1,p);
d4 := GetLineLenght(hr2,p);
d5 := GetLineLenght(he1,p);
d6 := GetLineLenght(he2,p);
d := d1;
pd := hl1;
if d2 < d then
begin
d := d2;
pd := hl2;
end;
if d3 < d then
begin
d := d3;
pd := hr1;
end;
if d4 < d then
begin
d := d4;
pd := hr2;
end;
if d5 < d then
begin
d := d5;
pd := he1;
end;
if d6 < d then
begin
d := d6;
pd := he2;
end;
if (d < dSnap) or (dSnap = -1234567) then
begin
x := pd.x;
y := pd.y;
dSnap := d;
result := true;
end;
end;
function TnetPath.ForceSnapToPipeLine(var x, y, dSnap: Double): Boolean;
var
d1,d2,d3,d4,d5,d6,d7,d8,d: Double;
p,pd: TDoublePoint;
onLine: Boolean;
begin
result := false;
p := DoublePoint(x,y);
d7 := GetDistToLine(hl1,hl2,p);
d8 := GetDistToLine(hr1,hr2,p);
if d7 > d8 then
begin
d := d8;
pd := DoublePoint(x,y);
PointToLine(hr1,hr2,pd.x,pd.y);
onLine := isPOintInLine(hr1,hr2,pd,1,0.1);
end
else
begin
d := d7;
pd := DoublePoint(x,y);
PointToLine(hl1,hl2,pd.x,pd.y);
onLine := isPointInLine(hl1,hl2,pd,1,0.1);
end;
if ((d < dSnap) or (dSnap = -1234567)) and onLine then
begin
x := pd.x;
y := pd.y;
dSnap := d;
result := true;
end;
end;
procedure TnetPath.DrawGuides(DEngine: TPCDrawEngine);
var
xp,xp1,xp2: TDoublePOint;
begin
DEngine.DrawPoint(hl1,clGray);
DEngine.DrawPoint(hl2,clGray);
DEngine.DrawPoint(hr1,clGray);
DEngine.DrawPoint(hr2,clGray);
DEngine.DrawPoint(he1,clGray);
DEngine.DrawPoint(he2,clGray);
end;
procedure TnetPath.DeleteDoors;
var
Door: TnetDoor;
i: Integer;
begin
try
for i := 0 to Doors.Count-1 do
begin
Door := TnetDoor(Doors[i]);
//Doors.Remove(Door);
//Door.Free;
DeleteDoorObj(Door);
end;
Doors.Clear;
DoorIndex := -1;
except
// ShowMessage(CPowerCadMessage + 'TnetPath.DeleteDoors');
end;
end;
function TnetPath.GetLeftCorner(var wp: TDoublePoint): TDoublePoint;
var
x2,x3,xpl,xpr:TdoublePoint;
dl,dr: Double;
rad: Double;
xHL1,xHl2,xHr1,xHR2: TDoublePoint;
begin
result := DoublePoint(0, 0);
xpl := wp;
xpr := wp;
xHL1 := MPoint(HL1, HL2, -20.0);
xHL2 := MPoint(HL2, HL1, -20.0);
xHR1 := MPoint(HR1, HR2, -20.0);
xHR2 := MPoint(HR2, HR1, -20.0);
PointToLine(xHL1, xHL2, xpl.x, xpl.y);
PointToLine(xHR1, xHR2, xpr.x, xpr.y);
dl := GetLineLenght(xpl, wp);
dr := GetLineLenght(xpr, wp);
if dl < dr then
begin
wp := xpl;
rad := GetRadOfLine(xHL1, xHL2);
x2 := RotatePoint(xHL1, xHL2, -rad);
x3 := RotatePoint(xHL1, xHR2, -rad);
if x3.y < x2.y then
begin
if x2.x < xhl1.x then
result := xhl2
else
result := xhl1;
end
else
begin
if x2.x < xhl1.x then
result := xhl1
else
result := xhl2;
end;
end
else
begin
wp := xpr;
rad := GetRadOfLine(xHR1, xHR2);
x2 := RotatePoint(xHR1, xHR2, -rad);
x3 := RotatePoint(xHR1, xHL2, -rad);
if x3.y < x2.y then
begin
if x2.x < xhR1.x then
result := xhR2
else
result := xhR1;
end
else
begin
if x2.x < xhR1.x then
result := xhR1
else
result := xhR2;
end;
end;
end;
function TnetPath.GetRightCorner(var wp: TDoublePoint): TDoublePoint;
var
x2,x3,xpl,xpr: TDoublePoint;
dl,dr: DOuble;
rad: Double;
xHL1,xHl2,xHr1,xHR2: TDoublePoint;
begin
xpl := wp;
xpr := wp;
xHL1 := MPoint(HL1, HL2, -20.0);
xHL2 := MPoint(HL2, HL1, -20.0);
xHR1 := MPoint(HR1, HR2, -20.0);
xHR2 := MPoint(HR2, HR1, -20.0);
PointToLine(xHL1, xHL2, xpl.x, xpl.y);
PointToLine(xHR1, xHR2, xpr.x, xpr.y);
dl := GetLineLenght(xpl, wp);
dr := GetLineLenght(xpr, wp);
if dl < dr then
begin
wp := xpl;
rad := GetRadOfLine(xHL1, xHL2);
x2 := RotatePoint(xHL1, xHL2, -rad);
x3 := RotatePoint(xHL1, xHR2, -rad);
if x3.y < x2.y then
begin
if x2.x > xhl1.x then
result := xhl2
else
result := xhl1;
end
else
begin
if x2.x > xhl1.x then
result := xhl1
else
result := xhl2;
end;
end
else
begin
wp := xpr;
rad := GetRadOfLine(xHR1, xHR2);
x2 := RotatePoint(xHR1, xHR2, -rad);
x3 := RotatePoint(xHR1, xHL2, -rad);
if x3.y < x2.y then
begin
if x2.x > xhR1.x then
result := xhR2
else
result := xhR1;
end
else
begin
if x2.x > xhR1.x then
result := xhR1
else
result := xhR2;
end;
end;
end;
procedure TnetPath.AddCols;
var
col: TNetCol;
begin
col := TnetCol.Create(Net, Self.p1);
Col.SetPosition;
Net.Structs.Add(col);
col := TnetCol.Create(Net, Self.p2);
Col.SetPosition;
Net.Structs.Add(col);
end;
procedure TnetPath.GetBounds(var figMaxX, figMaxY, figMinX,
figMinY: Double);
begin
figMaxX := a1.x;
figMaxY := a1.y;
figMinX := a1.x;
figMinY := a1.y;
if a2.x > figMaxX then
figMaxX := a2.x;
if b1.x > figMaxX then
figMaxX := b1.x;
if b2.x > figMaxX then
figMaxX := b2.x;
if a2.x < figMinX then
figMinX := a2.x;
if b1.x < figMinX then
figMinX := b1.x;
if b2.x < figMinX then
figMinX := b2.x;
if a2.y > figMaxY then
figMaxY := a2.y;
if b1.y > figMaxY then
figMaxY := b1.y;
if b2.y > figMaxY then
figMaxY := b2.y;
if a2.y < figMinY then
figMinY := a2.y;
if b1.y < figMinY then
figMinY := b1.y;
if b2.y < figMinY then
figMinY := b2.y;
end;
function TnetPath.HasDoor: Boolean;
var
i: Integer;
Door: TnetDoor;
begin
result := false;
for i:= 0 to Doors.Count -1 do
begin
Door := TnetDoor(Doors[i]);
if door.DoorObjType = dotDoor then
result := true;
end;
end;
function TnetPath.isLineIntersect(xp1, xp2: TDoublePoint): Boolean;
var
rp1, rp2: TDoublePoint;
begin
Result := false;
rp1 := p1^;
rp2 := p2^;
rp1.z := 0;
rp2.z := 0;
xp1.z := 0;
xp2.z := 0;
result := LinesIntersect(xp1, xp2, rp1, rp2);
end;
function TnetPath.MLen: Double;
begin
result := 0;
Result := (GetLineLenght(p1^,p2^));
end;
function TnetPath.InnerLen: Double;
var
// BPoints1,BPoints2: TDoublePointArr;
LenL: Double;
LenR: Double;
begin
Result := 0;
if Net <> nil then
begin
//Net.CollectBoundPoints(Self, BPoints1,BPoints2);
//if Length(BPoints1) > 0 then
// Result := GetLineLenght(p1^,BPoints1[0])-Self.Width;
//if Length(BPoints2) > 0 then
// Result := GetLineLenght(p2^,BPoints2[0])-Self.Width;
if (ip1 <> nil) and (ip2 <> nil) then
Result := GetLenByPoints(ip1^, ip2^)
else
begin
LenL := GetLenByPoints(el1, el2); //28.10.2010 GetLineLenght(el1, el2);
LenR := GetLenByPoints(er1, er2); //28.10.2010 GetLineLenght(er1, er2);
Result := Min(LenL, LenR);
end;
//Result := GetLenByPoints(el1, el2);
end;
end;
procedure TnetPath.Refresh;
var h1, h2, MaxDoorHeight, DoorH: Double;
Door: TNetDoor;
i: integer;
Function GetMaxDoorHeight: Double;
var dist1, dist2, LenH, LenG, koeff: Double;
PathPoint1: TDoublePoint;
begin
if CompareValue(h1, h2) = 0 then
Result := h1
else
begin
LenH := ABS(h1 - h2); // len diff
LenG := GetLenByPoints(p1^, p2^); //Sqrt(Sqr(p1.x - p2.x) + Sqr(p1.y - p2.y));
if Net.WorldDim then
LenG := LenG / 1000 * Net.MapScale
else
LenG := LenG / 10;
Koeff := LenH/LenG;
if CompareValue(h1, h2) = 1 then
begin
PathPoint1.x := p2.x;
PathPoint1.y := p2.y;
PathPoint1.z := h2;
end
else
begin
PathPoint1.x := p1.x;
PathPoint1.y := p1.y;
PathPoint1.z := h1;
end;
if Net.WorldDim then
begin
dist1 := GetLenByPoints(PathPoint1, Door.p1) / 1000 * Net.MapScale;
dist2 := GetLenByPoints(PathPoint1, Door.p2) / 1000 * Net.MapScale;
end
else
begin
dist1 := GetLenByPoints(PathPoint1, Door.p1) / 10;
dist2 := GetLenByPoints(PathPoint1, Door.p2) / 10;
end;
Result := RoundN((MaxDoorHeight + Min(dist1, dist2)* koeff), 2); //Max(dist1, dist2)* koeff;
end;
end;
begin
// íà âñÿêèé
if p1 = nil then
exit
else
if p2 = nil then
exit;
// îïðåäåëÿåì îêíà/äâåðè
if p1h = -1 then
h1 := F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.HeightRoom
else
h1 := p1h;
if p2h = -1 then
h2 := F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.HeightRoom
else
h2 := p2H;
// çäåñü - ïåðåñ÷åò âûñîò äâåðåé è îêîí äî äîïóñòèìûõ âåëè÷èí â çàâèñèìîòè îò âûñîòû áëîêà
if (h1 = 0) then
if (h2 = 0) then
exit; // åñëè îáà êðàÿ -- ïî íóëÿì -- íàõ îòñþäà (ïîëüçîâàòåëü ñàì äóðàê)
for i := 0 to Doors.Count - 1 do
begin
MaxDoorHeight := Min(h1, h2);
Door := TNetDoor(Doors[i]);
DoorH := Door.Height; // Âûñîòà äâåðè
//if Door.DoorObjType = dotWindow then
DoorH := DoorH + Door.WndPlacementHeight; // åñëè îêíî - äîáàâèòü âûñîòó ðàçìåùåíèÿ îêíà
if CompareValue(DoorH, MaxDoorHeight) = 1 then
begin
if CompareValue(h1, h2) <> 0 then
MaxDoorHeight := GetMaxDoorHeight;
if CompareValue(MaxDoorHeight, DoorH) = -1 then
begin
Door.Height := MaxDoorHeight - door.WndPlacementHeight - MetreToUom(0.1);//DoorH - (DoorH - MaxDoorHeight) - MetreToUom(0.1)
if door.Height < 0 then
Door.Height := 0;
end;
end;
end;
//
end;
procedure TnetPath.DeleteRegions;
var
i: Integer;
begin
// Tolik 21/11/2019 --
if Region <> 0 then
begin
//
DeleteObject(Region);
Region := 0;
end;
For i := 0 to Doors.Count-1 do
begin
TNetDoor(Doors[i]).DeleteRegion;
end;
For i := 0 to FSubRegions.Count-1 do
DeleteObject(HRGN(FSubRegions[i]));
FSubRegions.Clear;
end;
function TnetPath.LineIntersect(xp1, xp2: TDoublePoint; var ip: TDoublePoint): Boolean;
var
rp1,rp2: TDoublePoint;
begin
result := false;
rp1 := p1^;
rp2 := p2^;
rp1.z := 0;
rp2.z := 0;
xp1.z := 0;
xp2.z := 0;
result := GetIntersectionPoint(xp1,xp2,rp1,rp2,ip,false,false);
end;
procedure TnetPath.MoveDoors(nPath: TnetPath);
var
i: Integer;
Door: TNetDoor;
begin
try
for i := 0 to Doors.Count - 1 do
begin
Door := TnetDoor(Doors[i]);
if door.Start > Self.MLen then
begin
nPath.NewDoor(door.Start - Self.MLen, door.Len, door.DoorObjType);
door.Free;
Doors[i] := nil;
end;
end;
for i := Doors.Count - 1 downto 0 do
begin
Door := TnetDoor(Doors[i]);
if door = nil then
begin
Doors.Delete(i);
end;
end;
except
// ShowMessage(CPowerCadMessage + 'TnetPath.MoveDoors');
end;
end;
procedure TnetPath.SetLen(len: Double; back: Boolean);
var
xp1, xp2, np: TDoublePoint;
dx, dy, dLen, slen: Double;
pp1, pp2, pp, spp: PDoublePoint;
xPaths: TList;
i: Integer;
xPath: TnetPath;
begin
len := abs(Len);
len := Len + Width;
if self.PosType = ptHorizontal then
begin
if p1^.x > p2^.x then
begin
xp1 := p2^;
xp2 := p1^;
pp1 := p2;
pp2 := p1;
end
else
begin
xp1 := p1^;
xp2 := p2^;
pp1 := p1;
pp2 := p2;
end;
end
else
begin
if p1^.y > p2^.y then
begin
xp1 := p2^;
xp2 := p1^;
pp1 := p2;
pp2 := p1;
end
else
begin
xp1 := p1^;
xp2 := p2^;
pp1 := p1;
pp2 := p2;
end;
end;
slen := GetLineLength(xp1, xp2);
dLen := len - slen;
xPaths := TList.Create;
if back then
begin
np := Mpoint(xp1, xp2, -dLen);
spp := pp1;
dx := np.x - xp1.x;
dy := np.y - xp1.y;
end
else
begin
np := Mpoint(xp2, xp1, -dLen);
dx := np.x - xp2.x;
dy := np.y - xp2.y;
spp := pp2;
end;
Net.GetPathsOfKnot(spp, xPaths);
xPaths.Remove(Self);
for i := 0 to xpaths.Count - 1 do
begin
xPath := TNetPath(xPaths[i]);
if xPath.PosType <> PosType then
begin
pp := xPath.OtherPoint(spp);
pp^.x := pp^.x + dx;
pp^.y := pp^.y + dy;
end;
end;
spp^ := np;
xPaths.Free;
Net.RefreshPaths;
end;
function TnetPath.GetPoint(PType: Integer): TDoublePoint;
var
xp1, xp2: TDoublePOint;
begin
result := DoublePoint(0, 0);
if PType = 2 then
begin
if EQD(mpa.x, mpb.x) then
begin
if mpa.y > mpb.y then
begin
xp1 := mpa;
xp2 := mpb;
end
else
begin
xp1 := mpb;
xp2 := mpa;
end;
end
else
begin
if mpa.x > mpb.x then
begin
xp1 := mpa;
xp2 := mpb;
end
else
begin
xp1 := mpb;
xp2 := mpa;
end;
end;
Result := MPoint(xp1, xp2, -3.0);
end
else
if PType = 4 then
begin
if EQD(apa.x , apb.x) then
begin
if apa.y > apb.y then
begin
xp1 := apa;
xp2 := apb;
end
else
begin
xp1 := apb;
xp2 := apa;
end;
end
else
begin
if apa.x > apb.x then
begin
xp1 := apa;
xp2 := apb;
end
else
begin
xp1 := apb;
xp2 := apa;
end;
end;
Result := MPoint(xp1, xp2, -6.0);
end;
end;
procedure TnetPath.AfterDiv;
begin
try
if Assigned(FOnAfterDiv) then
FOnAfterDiv(Self);
finally
//if Net <> nil then
// Net.FPathDivision := nil;
end;
end;
procedure TnetPath.BeforeDiv;
begin
//if Net <> nil then
// Net.FPathDivision := Self;
if Assigned(FOnBeforeDiv) then
FOnBeforeDiv(Self);
end;
function TnetPath.AddDoorAtPt(pt: TDoublePoint; len: Double; aDoorObjType: TDoorObjType): TnetDoor;
var
s: Double;
begin
Result := nil;
if WType <> wtWall then
exit;
s := GetLineLenght(Self.p1^, pt);
//s := (abslen - len) /2;
//s := s + (width / 2);
s := s - (len / 2);
Result := TNetDoor.Create(s, width, len, aDoorObjType, net);
Doors.Add(Result);
end;
procedure TnetPath.AddLen(ALen: Double); //15.10.2010
var
StaticPoint: PDoublepoint; // òî÷êà êîòîðàÿ îñòàíåòñÿ íà ìåñòå
MovePoint: PDoublepoint; // òî÷êà êîòîðàÿ áóäåò ñìåùàòüñÿ
begin
MovePoint := nil;
// Åñëè X ïðèìåðíî îäèíàêîâûé, èùåì ó êîãî áîëüøå Y
if Abs(p1^.x - p2^.x) < 0.01 then
begin
if p1^.y < p2^.y then
MovePoint := p2
else
MovePoint := p1;
end
// èíà÷å ïåðåìåùàåì òî÷êó ñ áîëüøèì X
else
begin
if p1^.x < p2^.x then
MovePoint := p2
else
MovePoint := p1;
end;
//p2^ := MPoint(p1^, p2^, GetLineLenght(p1^,p2^) + ALen);
StaticPoint := SecondPoint(MovePoint);
MovePoint^ := MPoint(StaticPoint^, MovePoint^, GetLineLenght(p1^,p2^) + ALen);
end;
procedure TnetPath.AfterLoadProps;
begin
GArchEngine.AfterLoadProps(Self);
end;
procedure TnetPath.ApplyStyle(Dengine:TPCDrawEngine; Color:TColor);
begin
if FBrushStyle <> -1 then
FillRegions(Dengine, FBrushColor, FBrushStyle);
end;
procedure TnetPath.Assign(ASource: TNetPath);
begin
CopyFrom(ASource);
AssignProps(ASource);
end;
procedure TnetPath.AssignProps(APath: TNetPath);
begin
isArc := APath.isArc;
Angle := APath.Angle;
ArcAng := APath.ArcAng;
ArcRad := APath.ArcRad;
Inverted := APath.Inverted;
ArcCenter := APath.ArcCenter;
ArcA1 := APath.ArcA1;
ArcA2 := APath.ArcA2;
WStyle := APath.WStyle;
FColor := APath.FColor;
FBrushColor := APath.FBrushColor;
FBrushStyle := APath.FBrushStyle;
end;
function TnetPath.CmpIntersectPath(APath: TNetPath; MarginDelta:Double = 2; AEqualRotate: Pointer=nil): Integer;
//var
// p1InAPath, p2InAPath: Boolean;
// ap1InPath, ap2InPath: Boolean;
begin
Result := Net.CmpIntersectPaths(p1,p2, APath.p1, APath.p2, MarginDelta, AEqualRotate);
{Result := citNone;
if (PointNear(p1^, APath.p1^) and PointNear(p2^, APath.p2^)) or
(PointNear(p1^, APath.p2^) and PointNear(p2^, APath.p1^)) then
Result := citEqual
else
begin
p1InAPath := isPointInLine(APath.p1^, APath.p2^, p1^,1);
p2InAPath := isPointInLine(APath.p1^, APath.p2^, p2^,1);
ap1InPath := isPointInLine(p1^,p2^, APath.p1^,1);
ap2InPath := isPointInLine(p1^,p2^, APath.p2^,1);
if p1InAPath and p2InAPath then
Result := citEntry
else
if ap1InPath and ap2InPath then
Result := citAbsorb
else
if p1InAPath or p2InAPath or ap1InPath or ap2InPath then
Result := citSide;
//if isPointInLine(APath.p1^, APath.p2^, p1^,1) and isPointInLine(APath.p1^, APath.p2^, p2^,1) then
// Result := citEntry
//else
//if isPointInLine(p1^,p2^, APath.p1^,1) and isPointInLine(p1^,p2^, APath.p2^,1) then
// Result := citAbsorb;
end;}
end;
procedure TnetPath.DefineDoorsOwner;
var
i: Integer;
begin
for i := 0 to Doors.Count - 1 do
begin
TNetDoor(Doors[i]).FPath := Self;
end;
end;
procedure TnetPath.DefineInOutPoints;
var
PathList: TList;
i: Integer;
OutPoints: TDoublePointArr;
InnPoints: TDoublePointArr;
IsRoof: boolean;
//OutArea: Double;
//InnArea: Double;
begin
//op1 := nil; //@el1;
//op2 := nil; //@el2;
//ip1 := nil; //@er1;
//ip2 := nil; //@er2;
op1 := @el1;
op2 := @el2;
ip1 := @er1;
ip2 := @er2;
FIsInner := false;
FIsConture := false;
PathList := TList.Create;
// Îïðåäåëÿåì ñïèñîê ñåãìåíòîâ òàê ÷òîáû Self áûë â ñàìîì íà÷àëå
PathList.Assign(Net.Paths);
PathList.Remove(Self);
PathList.Insert(0, Self);
GetPathsConturePoints(PathList, @OutPoints, @InnPoints, {nil, nil,}false, nil, nil, nil, nil);
//OutArea := GetAreaFromPolygon(OutPoints);
//InnArea := GetAreaFromPolygon(InnPoints);
FIsConture := (Length(OutPoints) > 0) or (Length(InnPoints) > 0);
isroof := IfFiguraisroof(Net);
// Ïðîâåðÿåì, âõîäèò ëè îäèí êîíòóð OutPoints âî âòîðîé InnPoints
if (Length(OutPoints) > 0) and (Length(InnPoints) > 0) then
begin
if CheckContrureEntry(@OutPoints, @InnPoints, false, false, isroof) then
begin
if IsPtInArray(el1, @OutPoints) and IsPtInArray(er1, @InnPoints) then
begin
op1 := @el1;
op2 := @el2;
ip1 := @er1;
ip2 := @er2;
end
else
if IsPtInArray(er1, @OutPoints) and IsPtInArray(el1, @InnPoints) then
begin
op1 := @er1;
op2 := @er2;
ip1 := @el1;
ip2 := @el2;
end
else if CheckConturesEqual(@OutPoints, @InnPoints) then
begin
if IsPtInArray(er1, @InnPoints) then
begin
op1 := @el1;
op2 := @el2;
ip1 := @er1;
ip2 := @er2;
end
else
if IsPtInArray(el1, @InnPoints) then
begin
op1 := @er1;
op2 := @er2;
ip1 := @el1;
ip2 := @el2;
end;
end;
end
else
FIsInner := true; // ïðèçíàê ÷òî ñåãìåíò ìåæäó äâóìÿ êîíòóðàìè
end
else
begin
EmptyProcedure;
end;
SetLength(OutPoints, 0);
SetLength(InnPoints, 0);
PathList.Free;
end;
Procedure TnetPath.DeleteDoorObj(ADoor: TNetDoor);
begin
if Not ADoor.FDeleting then
begin
ADoor.DoDelete;
Doors.Remove(ADoor);
ADoor.Free;
end;
end;
procedure TnetPath.DoDelete;
var
Paths1, Paths2: TList;
Path, PathToCheck: TNetPath;
pt1, pt2, pt: PDoublePoint;
i,j, DefCnt: Integer;
//Tolik
CanRemovePoint: boolean;
PathCheckList: TList;
begin
if Not FDeleting then
begin
FDeleting := true;
if Assigned(FOnDelete) then
FOnDelete(Self);
end;
DefCnt := 3;
if (Net.Paths.Count > DefCnt)and(Net.fcomponID <> 0) and Not (ssShift in GGlobalShiftState) then
begin
Paths1 := Net.GetPathListByPoint(Self.p1);
Paths2 := Net.GetPathListByPoint(Self.p2);
if (Paths1 <> nil) and (Paths2 <> nil) then
begin
Paths1.Remove(Self);
Paths2.Remove(Self);
if (Paths1.Count > 0) and (Paths2.Count > 0) then
begin
pt1 := Self.p1;
pt2 := Self.p2;
if Paths1.Count > Paths2.Count then
begin
ExchangeObjects(Paths1, Paths2);
pt1 := Self.p2;
pt2 := Self.p1;
end;
// 13/10/2016-- Tolik -- åñëè òðåóãîëüíèê - íåõ óäàëÿòü è îáúåäèíÿòü à òî áóäå êàêà
CanRemovePoint := True;
if (TNetPath(Paths1[0]).p1 = TNetPath(Paths2[0]).p1) or
(TNetPath(Paths1[0]).p1 = TNetPath(Paths2[0]).p2) or
(TNetPath(Paths1[0]).p2 = TNetPath(Paths2[0]).p1) or
(TNetPath(Paths1[0]).p2 = TNetPath(Paths2[0]).p2) then
CanRemovePoint := False;
if CanRemovePoint then
begin
for i := 0 to Paths1.Count - 1 do
begin
Path := TNetPath(Paths1[i]);
if Path.p1 = pt1 then
Path.p1 := pt2
else if Path.p2 = pt1 then
Path.p2 := pt2;
end;
Net.DeletePoint(pt1);
end;
end;
end;
if Paths1 <> nil then
Paths1.Free;
if Paths2 <> nil then
Paths2.Free;
end;
end;
Procedure TnetPath.DoClick(X, Y: Double);
var
ModPoint: TModPoint;
begin
FSelecting := true;
try
// Ïðîâåðêà êëèêà íà modpoint //#From Oleg# //05.10.2010
ModPoint := TPCDrawing(Self.Net.Owner).HitTestModPoint(x,y);
if (ModPoint <> nil) and (ModPoint.Figure = Self.Net) then
begin
if PointNear(Self.p1^, DoublePoint(ModPoint.CoordX, ModPoint.CoordY)) then
TNet(Self.Net).DoClickPoint(Self.p1)
else if PointNear(Self.p2^, DoublePoint(ModPoint.CoordX, ModPoint.CoordY)) then
TNet(Self.Net).DoClickPoint(Self.p2);
end
else
begin
if Assigned(FOnSelect) then
FOnSelect(Self);
end;
finally
FSelecting := false;
end;
end;
Procedure TnetPath.DoDblClick;
begin
if Assigned(FOnDblClick) then
FOnDblClick(Self);
end;
Procedure TnetPath.DrawArcCenter(Dengine:TPCDrawEngine; Color:Tcolor; Style:Integer);
begin
// Òî÷êà ïî öåíòðó
DEngine.drawselectionpoint(ArcCenter.x, ArcCenter.y, ArcCenter.z, ptRect, 3, clGreen);
// ëèíèè îò öåíòðàëüíîé òî÷êè äî òî÷åê ñåãìåíòà
DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p1^.x,p1^.y, Color, 1, Style, 0);
DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p2^.x,p2^.y, Color, 1, Style, 0);
// Ëèíèÿ ìåæäó òî÷êàìè
DEngine.DrawLine(p1^.x,p1^.y, p2^.x,p2^.y, Color, 1, ord(psDot), 0);
end;
function TnetPath.ExistsPerpendPt: Boolean;
begin
Result := (epl1<>nil)or(epl2<>nil)or(epr1<>nil)or(epr2<>nil);
end;
procedure TnetPath.FillArcJoinPoints(aPoints, aLPoints: TList);
begin
aPoints.Clear;
aLPoints.Clear;
aPoints.Add(@ArcJoinA1);
aLPoints.Add(@ArcJoinA1L);
aPoints.Add(@ArcJoinA2);
aLPoints.Add(@ArcJoinA2L);
aPoints.Add(@ArcJoinB1);
aLPoints.Add(@ArcJoinB1L);
aPoints.Add(@ArcJoinB2);
aLPoints.Add(@ArcJoinB2L);
end;
procedure TnetPath.FillArcPointsByEndPoints(var aPoints: TDoublePointArr; ap1, ap2: PDoublePoint; aDxfMode: Boolean=false);
var
Radius, a1, a2: Double;
OldDxfMode: Boolean;
Fpoints: T2DPointArray;
i: integer;
begin
SetLength(aPoints, 0);
Radius := GetLineLenght(ap1^, Self.ArcCenter);
a1 := GetRadOfLine(Self.ArcCenter, ap1^);
a2 := GetRadOfLine(Self.ArcCenter, ap2^);
if Not Self.Inverted then
ExchangeDouble(a1, a2);
OldDxfMode := DxfMode; // ïîâûøàåì òî÷íîñòü - êîëè÷åñòâî òî÷åê äëÿ äóãè
DxfMode := aDxfMode;
try
BezierArcPoints(Fpoints, Self.ArcCenter.x, Self.ArcCenter.y, Radius, a1, a2);
if Length(Fpoints) > 0 then
begin
SetLength(aPoints, Length(Fpoints));
for i := 0 to Length(Fpoints) - 1 do
begin
aPoints[i].x := Fpoints[i].x;
aPoints[i].y := Fpoints[i].y;
aPoints[i].z := 0;
end;
SetLength(Fpoints, 0);
end;
finally
DxfMode := OldDxfMode;
end;
end;
procedure TnetPath.FillRegions(Dengine:TPCDrawEngine; aBrushColor: TColor; aBrushStyle: Integer);
var
i: Integer;
begin
if FSubRegions.Count = 0 then
DEngine.FillRgn(Region, aBrushColor, aBrushStyle)
else
begin
for i := 0 to FSubRegions.Count - 1 do
DEngine.FillRgn(HRGN(FSubRegions[i]), aBrushColor, aBrushStyle);
end;
end;
function TnetPath.GetArcLPointByPt(apt: PDoublePoint): PDoublePoint;
begin
Result := nil;
if EQDP(ArcJoinA1, apt^) then
Result := @ArcJoinA1L
else if EQDP(ArcJoinA2, apt^) then
Result := @ArcJoinA2L
else if EQDP(ArcJoinB1, apt^) then
Result := @ArcJoinB1L
else if EQDP(ArcJoinB2, apt^) then
Result := @ArcJoinB2L
else if EQDP(ArcJoinA1L, apt^) then
Result := @ArcJoinA1
else if EQDP(ArcJoinA2L, apt^) then
Result := @ArcJoinA2
else if EQDP(ArcJoinB1L, apt^) then
Result := @ArcJoinB1
else if EQDP(ArcJoinB2L, apt^) then
Result := @ArcJoinB2;
if Result <> nil then
if EQDP(Result^, apt^) then
Result := nil;
end;
function TnetPath.GetConnected(APt: PDoublePoint): TNetPath;
var
i: integer;
Path: TNetPath;
begin
Result := nil;
for i := 0 to Net.Paths.Count - 1 do
begin
Path := TNetPath(Net.Paths[i]);
if (Path <> Self) and ((Path.p1 = APt) or (Path.p2 = APt)) then
begin
Result := Path;
Break; //// BREAK ////
end;
end;
end;
function TnetPath.GetConnectedPoint(APath: TNetPath): PDoublePoint;
begin
Result := nil;
if (p1 = APath.p1) or (p1 = APath.p2) then
Result := p1
else if (p2 = APath.p2) or (p2 = APath.p1) then
Result := p2;
end;
function TnetPath.GetConnectedSide(APath: TNetPath): Integer;
begin
Result := Self.GetPointSide(GetConnectedPoint(APath));
end;
function TnetPath.GetConturePolygon: TDoublePointArr;
var
i: Integer;
begin
SetLength(Result, 8);
//Result[0] := el1;
//Result[1] := el2;
//Result[2] := er2;
//Result[3] := er1;
//Result[4] := el1;
Result[0] := el1;
Result[1] := el2;
Result[2] := el2;
Result[3] := er2;
Result[4] := er2;
Result[5] := er1;
Result[6] := er1;
Result[7] := el1;
end;
function TnetPath.GetConturePoints(aAllowEPoints: Boolean; aPointSide: Integer=0; aPathSide: Char=#0): TList;
procedure AddPtToList(aPt: PDoublePoint; aPtSide: Integer; aSide: Char);
begin
if ((aPointSide = 0) or (aPointSide = aPtSide)) and ((aPathSide=#0) or (aPathSide = aSide)) then
Result.Add(aPt);
end;
begin
Result := TList.Create;
//if (aSide = 0) or (aSide = 1) then
// Result.Add(@r1);
//if (aSide = 0) or (aSide = 2) then
// Result.Add(@r2);
//if (aSide = 0) or (aSide = 1) then
// Result.Add(@l1);
//if (aSide = 0) or (aSide = 2) then
// Result.Add(@l2);
AddPtToList(@r1, 1, 'r');
AddPtToList(@r2, 2, 'r');
AddPtToList(@l1, 1, 'l');
AddPtToList(@l2, 2, 'l');
if aAllowEPoints then
begin
//if (aSide = 0) or (aSide = 1) then
// Result.Add(@er1);
//if (aSide = 0) or (aSide = 2) then
// Result.Add(@er2);
//if (aSide = 0) or (aSide = 1) then
// Result.Add(@el1);
//if (aSide = 0) or (aSide = 2) then
// Result.Add(@el2);
AddPtToList(@er1, 1, 'r');
AddPtToList(@er2, 2, 'r');
AddPtToList(@el1, 1, 'l');
AddPtToList(@el2, 2, 'l');
end;
end;
function TnetPath.GetDoorByComponID(AComponID: Integer): TNetDoor;
var
i: Integer;
begin
Result := nil;
for i := 0 to Doors.Count - 1 do
begin
if TNetDoor(Doors[i]).FComponID = AComponID then
begin
Result := TNetDoor(Doors[i]);
Result.FPath := Self;
Break; //// BREAK ////
end;
end;
end;
function TnetPath.GetFullConture: TDoublePointArr;
var
pa1, pa2, pb1, pb2: TDoublePoint;
DirectionKoef: Integer;
begin
SetLength(Result, 4);
// pa1-pa2 îïðåäåëÿåì êàê áîëåå äëèííàÿ ëèíèÿ ÷åì pb1-pb2
if GetLineLength(Self.r1, Self.r2) < GetLineLength(Self.l1, Self.l2) then
begin
pa1 := l1;
pa2 := l2;
pb1 := r1;
pb2 := r2;
end
else
begin
pa1 := r1;
pa2 := r2;
pb1 := l1;
pb2 := l2;
end;
DirectionKoef := GetParallelPointDirectionKoeff(pa1, pa2, pb1);
GetParallelPoints(pa1, pa2, pb1, pb2, DirectionKoef * Self.Width);
Result[0] := pa1;
Result[1] := pa2;
Result[2] := pb2;
Result[3] := pb1;
end;
function TnetPath.GetHeight: Double;
begin
Result := 0;
if Assigned(FOnGetHeight) then
Result := FOnGetHeight(Self);
end;
function TnetPath.GetHeightOfPt(pt: PDoublePoint): Double;
begin
Result := 0;
if Assigned(FOnGetHeightOfPt) then
Result := FOnGetHeightOfPt(Self, pt);
end;
function TnetPath.GetLenByPoints(p1, p2: TDoublePoint): Double;
var
//AngGrad: Double;
//radius: Double;
PointsAng: Double;
begin
Result := 0;
if IsArc then
begin
//AngGrad := ArcAng * 180/pi;
//radius := GetLineLenght(ArcCenter, p1);
//Result := (pi * radius * AngGrad) / 180; // ñëåäñòâèå èç (2 * pi * radius) * (AngGrad / 360)
//a1 := GetRadOfLine(p1, ArcCenter);
//a2 := GetRadOfLine(p2, ArcCenter);
//PointsAng := 0;
//if Not APatch.Inverted then
// PointsAng := a1-a2;
//else
// PointsAng := a2-a1;
//21.04.2011
//PointsAng := 0;
// if Inverted 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);
Result := GetArcLenByPoints(p1, p2, ArcCenter, Inverted);
end
else
Result := GetLineLenght(p1, p2);
end;
// Âåðíåò äëèíó äëÿ ïîêàçà
function TnetPath.GetLenForShow(AShowPathLengthType: TShowPathLengthType): Double;
begin
Result := 0;
case AShowPathLengthType of
sltPoints:
Result := Len;
sltOuter, sltInner:
begin
case AShowPathLengthType of
sltOuter:
Result := OutLen;
sltInner:
Result := InnerLen;
end;
if Net.WorldDim then
Result := Result / 1000 * Net.MapScale
else
Result := Result / 10;
end;
end;
end;
function TnetPath.GetObjInPoint(x, y: Double): TObject;
var
ipt: TPOint;
dx,dy,z: Double;
i: Integer;
Door: TnetDoor;
begin
Result := nil;
if WStyle = wsLine then
begin
if isPointInLine(p1^,p2^,DoublePoint(x,y),1) then
Result := Self;
end
else
if (wType <> wtHalf) and assigned(net) and assigned(net.XDrawEngine) and (region <> 0) then
begin
dx := x;
dy := y;
z := 0;
net.XDrawEngine.ConvertPoint(dx,dy,z);
ipt := Point(round(dx),round(dy));
for i := 0 to Doors.Count - 1 do
begin
Door := TnetDoor(Doors[i]);
if ptInRegion(Door.Region,ipt.x,ipt.Y) then
begin
Result := Door;
exit;
end;
end;
if ptInRegion(region,ipt.x,ipt.Y) then
Result := Self;
end
else
begin
if isPointInLine(p1^,p2^,DoublePoint(x,y),1) then
Result := Self;
end;
end;
function TNetPath.GetPointByLenghType(ASideNum: Integer; aLengthType: TShowPathLengthType): PDoublePoint;
begin
Result := nil;
case ASideNum of
1:
case aLengthType of
sltPoints:
Result := Self.p1;
sltInner:
Result := Self.ip1;
sltOuter:
Result := Self.op1;
end;
2:
case aLengthType of
sltPoints:
Result := Self.p1;
sltInner:
Result := Self.ip1;
sltOuter:
Result := Self.op1;
end;
end;
end;
function TnetPath.GetPointByPerpend(aPerpendPt: PDoublePoint): PDoublePoint;
begin
Result := nil;
if epl1 = aPerpendPt then
Result := @el1
else if epr1 = aPerpendPt then
Result := @er1
else if epl2 = aPerpendPt then
Result := @el2
else if epr2 = aPerpendPt then
Result := @er2;
end;
function TnetPath.GetPointsBySide(ASideNum: Integer; var L, R, LR, RL: TDoublePoint): Boolean;
begin
Result := false;
L := DoublePoint(0,0);
R := DoublePoint(0,0);
LR := DoublePoint(0,0);
RL := DoublePoint(0,0);
if ASideNum = 1 then
begin
L := el1;
R := er1;
LR := LR1;
RL := RL1;
Result := true;
end
else if ASideNum = 2 then
begin
L := el2;
R := er2;
LR := LR2;
RL := RL2;
Result := true;
end;
end;
function TnetPath.GetPointBySide(ASideNum: Integer): PDoublePoint;
begin
Result := nil;
if aSideNum = 1 then
Result := p1
else if aSideNum = 2 then
Result := p2;
end;
function TnetPath.GetPointSide(aPoint: PDoublePoint): Integer;
begin
Result := 0;
if p1 = aPoint then
Result := 1
else if p2 = aPoint then
Result := 2;
end;
function TnetPath.GetTrianglePointsBySide(ASideNum: Integer; var L, R, T: TDoublePoint): Boolean;
var
LR, RL: TDoublePoint;
FindedPoint: Boolean;
begin
Result := Self.GetPointsBySide(ASideNum, L, R, LR, RL);
if Result then
begin
// Âûáèðàåì òðåòþþ òî÷êó èç LR èëè RL, â çàâèñèìîñòè êîòîðàÿ èç íèõ ÿâëÿåòñÿ ïåðïåíäèêóëÿðîì - ëåæèò íà ëèíèè
FindedPoint := false;
if IsPointInLine(el1, el2, LR, 1) then
begin
FindedPoint := true;
T := LR;
end
else if IsPointInLine(er1, er2, RL, 1) then
begin
FindedPoint := true;
T := RL;
end
else
Result := false;
end;
end;
procedure TnetPath.InvertPerpendSide(aUpdateRegion: Boolean=true);
begin
Self.FPerpendSide := Self.FPerpendSide xor 1;
Self.Net.RefreshPaths(aUpdateRegion);
end;
function TnetPath.IsInnerNiche(aNiche: TNetDoor; aRefreshPathPoints: Boolean): Boolean;
begin
Result := false;
if aNiche <> nil then
begin
if aRefreshPathPoints then
DefineInOutPoints;
aNiche.CalculatePoints(p1^,p2^);
Result := IsPointInLine(ip1^, ip2^, aNiche.ClearP1, 1, 0.1) and IsPointInLine(ip1^, ip2^, aNiche.ClearP2, 1, 0.1);
end;
end;
function TnetPath.LenByType(AType: Integer): Double;
begin
Result := 0;
if AType = ltInner then
Result := InnerLen
else if AType = ltOuter then
Result := OutLen;
end;
function TnetPath.OutLen: Double;
var
LenL: Double;
LenR: Double;
begin
Result := 0;
if (op1 <> nil) and (op2 <> nil) then
Result := GetLenByPoints(op1^, op2^)
else
begin
LenL := GetLenByPoints(el1, el2); //28.10.2010 GetLineLenght(el1, el2);
LenR := GetLenByPoints(er1, er2); //28.10.2010 GetLineLenght(er1, er2);
Result := Max(LenL, LenR);
end;
//Result := GetLenByPoints(er1, er2);
end;
function TnetPath.ProperLen: Double;
var
//LR1, LR2, RL1, RL2: TDoublePoint;
LenL, LenR, LenL1R2, LenL2R1, LenR1L2, LenR2L1: Double;
begin
if IsArc then
Result := InnerLen
else
begin
// Äëèíà L ÷àñòè ñåãìåíòà
LenL := GetLineLenght(el1, el2);
// Äëèíà R ÷àñòè ñåãìåíòà
LenR := GetLineLenght(er1, er2);
// Äëèíà L ÷àñòè ñåãìåíòà ñ òî÷êîé èç R2
LenL1R2 := GetLineLenght(el1, LR2);
// Äëèíà L ÷àñòè ñåãìåíòà ñ òî÷êîé èç R1
LenL2R1 := GetLineLenght(el2, LR1);
// Äëèíà R ÷àñòè ñåãìåíòà ñ òî÷êîé èç L2
LenR1L2 := GetLineLenght(er1, RL2);
// Äëèíà R ÷àñòè ñåãìåíòà ñ òî÷êîé èç L1
LenR2L1 := GetLineLenght(er2, RL1);
// èùåì êðàò÷àéøóþ äëèíó
Result := Min(LenL, LenR);
Result := Min(Result, LenL1R2);
Result := Min(Result, LenL2R1);
Result := Min(Result, LenR1L2);
Result := Min(Result, LenR2L1);
end;
end;
procedure TnetPath.PointToParralelLine;
begin
LR1 := er1;
LR2 := er2;
RL1 := el1;
RL2 := el2;
// òî÷êà er1 îïóùåíà íà ëèíèþ el1, el2
PointtoLine(el1, el2, LR1.x,LR1.y);
// òî÷êà er2 îïóùåíà íà ëèíèþ el1, el2
PointtoLine(el1, el2, LR2.x,LR2.y);
// òî÷êà el1 îïóùåíà íà ëèíèþ er1, er2
PointtoLine(er1, er2, RL1.x,RL1.y);
// òî÷êà el2 îïóùåíà íà ëèíèþ er1, er2
PointtoLine(er1, er2, RL2.x,RL2.y);
end;
function TnetPath.SecondPoint(p: PDoublePoint): PDoublePoint;
begin
result := nil;
if (p = p1) then
result := p2
else if (p = p2) then
result := p1;
end;
procedure TnetPath.SetEPoints;
begin
Self.er1 := Self.r1;
Self.er2 := Self.r2;
Self.el1 := Self.l1;
Self.el2 := Self.l2;
end;
procedure TnetPath.SetLenByType(ALen: Double; AType: Integer);
var
StepCount: Integer;
begin
StepCount := 0;
DefineInOutPoints;
// Óñòàíàâëèâàåì äëèíó â íåñêîëüêî ïîïûòîê,
// òàê êàê èç-çà ïðè èçìåíåíèè äëèíû, èçìåíèòñÿ óãîë ñ äðóãèì ñåãìåíòîì è ýòà äëèíà áóäåò èñêàæåíà
while Abs(ALen-LenByType(AType)) > 0.001 do
begin
AddLen(ALen-LenByType(AType));
Net.RefreshPaths; //Self.Refresh;
Net.SetModified; //03.02.2012 Net.ResetRegion;
StepCount := StepCount+1;
if StepCount > 7 then
Break; //// BREAK ////
end
end;
procedure TnetPath.SetInnerLen(ALen: Double);
begin
SetLenByType(ALen, ltInner);
end;
procedure TnetPath.SetOutLen(ALen: Double);
begin
SetLenByType(ALen, ltOuter);
end;
procedure TnetPath.Select;
var
Index: integer;
begin
if Net <> nil then
begin
Index := Net.Paths.IndexOf(Self);
if Index <> -1 then
begin
//27.07.2011 Net.SelIndex := Index + 1;
//27.07.2011 Net.SelType := stPath;
Net.SelectPath(Index + 1);
end;
end;
end;
procedure TnetPath.SelectDoor(ADoor: TNetDoor);
var
Index: Integer;
begin
Index := Doors.IndexOf(ADoor);
if Index <> -1 then
DoorIndex := Index;
end;
procedure TnetPath.TestShowPointsInfo;
var
Msg: String;
procedure PointToMsg(APointName: String; APoint: TDoublePoint);
begin
if Msg <> '' then
Msg := Msg + #13+#10;
Msg := Msg + APointName + ': x-'+FloatToStr(APoint.x)+' y-'+FloatToStr(APoint.y);
end;
begin
//Msg
PointToMsg('p1', p1^);
PointToMsg('r1', r1);
PointToMsg('l1', l1);
PointToMsg('LR1', LR1);
PointToMsg('RL1', RL1);
Msg := Msg + #13+#10;
PointToMsg('p2', p2^);
PointToMsg('r2', r2);
PointToMsg('l2', l2);
PointToMsg('LR2', LR2);
PointToMsg('RL2', RL2);
ShowMessage(Msg);
end;
// Tolik 12/07/2018 --
Function TnetPath.GetRelatedPaths: TList;
var i : Integer;
currPath: TNetPath;
begin
Result := TList.Create;
for i := 0 to Net.Paths.Count - 1 do
begin
currPath := TNetPath(Net.Paths);
if currPath <> Self then
if Self.Connected(currPath) then
if Result.IndexOf(currPath) = -1 then
Result.Add(currPath);
end;
end;
{ TWallPath }
function TWallPath.Closed: Boolean;
begin
result := false;
result := EQDP(actualpoints[1], actualpoints[PointCount]);
end;
constructor TWallPath.create(p1: TDoublepoint; xNet: Tnet);
begin
inherited create(0, dsTrace, nil);
Initialize; // tolik 29/07/2021 --
Net := xNet;
pointcount := 1;
SnapPoint(p1.x, p1.y);
Valid := True;
RefPaths := TList.Create;
FStarted := False;
CIndex := 0;
end;
class function TWallPath.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var
points: TDoublePointArr;
i, PointArrayIndex: Integer;
// Tolik 21/12/2019 -- ïðîâåðêà ïîñëåäíåé òî÷êè, ÷òîáû íå çàôèãà÷èòü òàêóþ æå
function CheckPointisNotLastPoint(aPoint: TDoublePoint): Boolean;
var ArrayLen: integer;
begin
Result := True;
if Length(points) > 0 then
begin
ArrayLen := Length(Points) - 1;
if ((CompareValue(TDoublePoint(points[ArrayLen]).x, aPoint.x) = 0) and
(CompareValue(TDoublePoint(points[ArrayLen]).y, aPoint.y) = 0)) then
Result := False;
end;
end;
//
begin
//DrawShadowCrossPoints;
result := nil;
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
if TWallPath(Shadow).valid and assigned(ActiveNet) then
begin
while (Shadow.PointCount > 1) and EQDP(Shadow.FigurePoints[Shadow.PointCount], Shadow.FigurePoints[Shadow.PointCount - 1]) do
begin
Shadow.PointCount := Shadow.PointCount - 1;
end;
// Shadow.PointCount := Shadow.PointCount-1;
// Tolik 21/12/2019 --
//SetLength(Points, Shadow.PointCount{-1});
SetLength(Points, 0);
PointArrayIndex := 0;
//
For i := 1 to Shadow.PointCount{-1} do
// SetLength(Points,Shadow.PointCount-1);
// For i := 1 to Shadow.PointCount-1 do
begin
// Tolik 21/12/2019 -- çäåñü ïðîâåðêà, ÷òîáû ïðè êëèêå â îäíîé òî÷êå íå íàñîçäàâàòü ïóòåé ñ îäèíàêîâûìè êîîðäèíàòàìè
//Points[i - 1] := Shadow.FigurePoints[i];
if CheckPointisNotLastPoint(TDoublePoint(Shadow.FigurePoints[i])) then
begin
inc(PointArrayIndex);
SetLength(points, PointArrayIndex);
Points[PointArrayIndex - 1] := Shadow.FigurePoints[i];
TDoublePoint(Points[PointArrayIndex - 1]).z := 0; // íà âñÿêèé, ÷òîáû íå ïîïàë ìóñîð
end;
end;
ActiveNet.MakePathOnShadow(points); //03.06.2013 ActiveNet.MakePath(points);
end;
SetLength(Points, 0);// Tolik 24/12/2019 --
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
class function TWallPath.CreateShadow(x, y: Double): TFigure;
begin
Result := nil;
if not assigned(ActiveNet) then
Exit;
Result := TWallPath.Create(DoublePoint(x, y), ActiveNet);
end;
destructor TWallPath.Destroy;
begin
RefPaths.Free;
inherited;
end;
procedure TWallPath.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
i, k: Integer;
mp, p1, p2: TDoublePoint;
xp1, xpmin, xpa: TDoublePoint;
l, d, dmin: Double;
ltext, uText: String;
rgn: HRGN;
xPath: TnetPath;
aLength: string;
aText: string;
begin
DEngine.Canvas.pen.mode := pmXor;
dMin := 0; //#From Oleg# //14.09.2010
for i := 0 to RefPaths.Count - 1 do
begin
xPath := TNetPath(RefPaths[i]);
for k := 1 to PointCount do
begin
xP1 := ActualPoints[k];
PointToLine(xPath.p1^, xPath.p2^, xp1.x, xp1.y);
d := GetLineLength(xp1, ActualPoints[k]);
if k = 1 then
begin
dMin := d;
xpMin := xp1;
xpa := ActualPoints[k];
end
else
begin
if d < dMin then
begin
dMin := d;
xpMin := xp1;
xpa := ActualPoints[k];
end;
end;
end;
p1 := xpmin;
p2 := xpa;
// ===
Dengine.drawline(p1, p2, clLime, 1, ord(psSOlid), 0);
mp := MPoint(p1, p2);
l := GetLen(p1, p2);
if l > 0 then
begin
aLength := FormatFloat(ffMask, MetreToUOM(l));
if Net.WorldDim then
aText := GetUOMString(GCurrProjUnitOfMeasure)
else
aText := cCadClasses_Mes6;
Dengine.TraceText(mp, clLime, aLength + aText, 'Arial', 8);
end;
end;
if FStarted then
begin
for i := 1 to PointCount - 1 do
begin
p1 := ActualPoints[i];
p2 := ActualPoints[i + 1];
// ===
DEngine.drawline(p1.x, p1.y, p2.x, p2.y, clLime, 1, ord(psSolid), 0);
if (i = PointCount - 1) then
begin
mp := MPoint(p1, p2);
l := GetLen(p1, p2);
if l > 0 then
begin
aLength := FormatFloat(ffMask, MetreToUOM(l));
if Net.WorldDim then
aText := GetUOMString(GCurrProjUnitOfMeasure)
else
aText := cCadClasses_Mes6;
if EQD(p1.x, p2.x) then
mp := MovePoint(mp, 2, 0)
else
mp := MovePoint(mp, 0, 2);
Dengine.TraceText(mp, clLime, aLength + aText, 'Arial', 8);
end;
end;
end;
if pointCount > 2 then
begin
p1 := ActualPoints[1];
p2 := ActualPoints[PointCount];
if EQDP(p1, p2) then
begin
rgn := 1;
Dengine.DrawCircle(p1.x, p1.y, 4, clLime, 1, ord(psSolid), 0, ord(bsClear), rgn, false);
end;
end;
end;
end;
function TWallPath.GetLen(p1, p2: TDoublePoint): Double;
var
wt: Double;
l: Double;
begin
result := 0;
l := GetLineLenght(p1, p2);
if l = 0 then
begin
result := 0;
exit;
end;
wt := net.WallThick;
Result := l{ - wt};
if Net.WorldDim then
Result := Result / 1000 * Net.MapScale
else
Result := Result / 10;
end;
//Tolik 18/01/2022 - - ñòàðàÿ çàêîììåí÷åíà, ñì íèæå
function TWallPath.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean;
var
xPath: TNetPath;
Cad: TPowercad;
distx, disty: Double;
DistToCrossPointX, DistToCrossPointY: Double;
begin
//DrawShadowCrossPoints; // Tolik 17/01/2022 --
if GCadForm.cbMagnetWalls.Down then
begin
if PointCount > 1 then
begin
x := ActualPoints[PointCount].x;
y := ActualPoints[Pointcount].y;
end;
if Assigned(GWallPathPointX) then
begin
x := GWallPathPointX.x;
DistToCrossPointX := Sqrt(sqr(GWallPathPointX.x - x) + sqr(GWallPathPointX.y - y));
if (compareValue(DistToCrossPointX, 2) < 1) then
y := GWallPathPointX.y;
end;
if Assigned(GWallPathPointY) then
begin
DistToCrossPointY := Sqrt(sqr(GWallPathPointY.x - x) + sqr(GWallPathPointY.y - y));
if not Assigned(GWallPathPointX) then
begin
y := GWallPathPointY.y;
if (compareValue(DistToCrossPointY, 2) < 1) then
x := GWallPathPointY.x;
end
else
begin
if (compareValue(DistToCrossPointX, 2) > 1) then
y := GWallPathPointY.y;
end;
end;
end;
if ClickIndex > 1 then
begin
if (not GCadForm.cbMagnetWalls.Down) then
begin
x := ActualPoints[ClickIndex].x;
y := ActualPoints[ClickIndex].y;
end;
end;
if ((not GCadForm.cbMagnetWalls.Down) or
(GCadForm.cbMagnetWalls.Down and (ssShift in GGlobalShiftState))) then // Tolik 19/01/2022 --
SnapPoint(x, y);
Result := false;
Shift := [];
if assigned(Net.Owner) then
begin
Cad := Tpowercad(Net.Owner);
Shift := Cad.CurrentShift;
end;
if not FStarted and not(ssShift in Shift) then
FStarted := True;
if not FStarted then
begin
xPath := Net.GetPathOfPoint(x, y);
if assigned(xPath) then
RefPaths.Add(xPath);
end;
if FStarted and (cIndex = 0) then
begin
pointcount := 2;
actualpoints[1] := Doublepoint(x, y);
actualpoints[2] := Doublepoint(x, y);
end;
if FStarted then
CIndex := CIndex + 1;
if CIndex > 1 then
begin
PointCount := PointCount + 1;
actualPoints[clickIndex] := DoublePoint(x, y);
actualPoints[clickIndex + 1] := DoublePoint(x, y);
//Tolik 19/01/2022 - - íå çíàþ, íàõ. ýòî ... ëèøíÿÿ òî÷êà íàõåð íå íóæíàÿ, êîòîðóþ ïîòîì æå è óäàëÿòü
// ïðè ñîçäàíèè ñòåíû? çàêîììåíòèë ïîêà ÷òî
{
if assigned(net) and (ActiveNet.IsPOintOnWall(Doublepoint(x, y))) then
begin
PointCount := PointCount + 1;
actualPoints[PointCount] := DoublePoint(x, y);
Result := True;
end
else
}
if assigned(net) and (ActiveNet.IsPOintOnWall(Doublepoint(x, y))) then
begin
//PointCount := PointCount + 1;
//actualPoints[PointCount] := DoublePoint(x, y);
Result := True;
end
else
//
if Closed then
begin
PointCount := PointCount + 1;
// Tolik 19/01/2022 --
//actualPoints[PointCount] := DoublePoint(x, y);
if not GCadForm.cbMagnetWalls.Down then
actualPoints[PointCount] := DoublePoint(x, y);
//
Result := True;
end;
end;
{
if GCadForm.cbMagnetWalls.Down then
begin
if not (ssShift in GGlobalShiftState) then
begin
if checkNoConnectedPrevPoint then
begin
distx := ABS(ActualPoints[CIndex - 1].x - x);
disty := ABS(ActualPoints[CIndex - 1].y - y);
if CompareValue(distx, disty) = 1 then
ActualPoints[CIndex - 1] := DoublePoint(ActualPoints[CIndex - 1].x, y)
else
ActualPoints[CIndex - 1] := DoublePoint(x, ActualPoints[CIndex - 1].y);
end;
end;
end;
}
end;
{
function TWallPath.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean;
var
xPath: TNetPath;
Cad: TPowercad;
begin
DrawShadowCrossPoints; // Tolik 17/01/2022 --
if ClickIndex > 1 then
begin
x := ActualPoints[ClickIndex].x;
y := ActualPoints[ClickIndex].y;
end;
SnapPoint(x, y);
Result := false;
Shift := [];
if assigned(Net.Owner) then
begin
Cad := Tpowercad(Net.Owner);
Shift := Cad.CurrentShift;
end;
if not FStarted and not(ssShift in Shift) then
FStarted := True;
if not FStarted then
begin
xPath := Net.GetPathOfPoint(x, y);
if assigned(xPath) then
RefPaths.Add(xPath);
end;
if FStarted and (cIndex = 0) then
begin
pointcount := 2;
actualpoints[1] := Doublepoint(x, y);
actualpoints[2] := Doublepoint(x, y);
end;
if FStarted then
CIndex := CIndex + 1;
if CIndex > 1 then
begin
PointCount := PointCount + 1;
actualPoints[clickIndex] := DoublePoint(x, y);
actualPoints[clickIndex + 1] := DoublePoint(x, y);
if assigned(net) and (ActiveNet.IsPOintOnWall(Doublepoint(x, y))) then
begin
PointCount := PointCount + 1;
actualPoints[PointCount] := DoublePoint(x, y);
Result := True;
end
else
if Closed then
begin
PointCount := PointCount + 1;
actualPoints[PointCount] := DoublePoint(x, y);
Result := True;
end;
end;
end;
}
function TWallPath.checkNoConnectedPrevPoint:Boolean; // Tolik 18/01/2021 --
var i: integer;
begin
Result := False;
if PointCount > 2 then
begin
Result := True;
for I := 0 to Net.Points.Count - 1 do
begin
if CompareValue(ActualPoints[PointCount - 1].x, PDoublePoint(Net.Points[i])^.x, 0.2) = 0 then
if CompareValue(ActualPoints[PointCount - 1].y, PDoublePoint(Net.Points[i])^.y, 0.2) = 0 then
begin
result := false;
break;
end;
end;
end;
end;
function TWallPath.ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean;
var
dx, dy: Double;
i: integer;
cP: TDoublePoint;
Len_X, Len_Y: double;
AngleOut: Double;
LenSize: Double;
FullLenSize: Double;
isVertical: Boolean;
ax, ay: Double;
distx, disty: Double;
begin
result := false;
if PointCount = 0 then
begin
PointCount := 0;
Exit;
end;
//DrawShadowCrossPoints; // Tolik 17/01/2022 --
//else
if GCadForm.cbMagnetWalls.Down then
//if false then
begin
DefineShadowCrossPoints(x,y); // Tolik 17/01/2022 --
if (ssShift in GGlobalShiftState) then
begin
ax := x;
ay := y;
if GWallPathPointX <> nil then
begin
if CompareValue(GWallPathPointX.x, ActualPoints[PointCount].x, 1) = 0 then
ax := GWallPathPointX.x;
if GWallPathPointY = nil then
begin
if CompareValue(GWallPathPointX.y, ActualPoints[PointCount].y, 1) = 0 then
ay := GWallPathPointX.y;
end;
end;
if GWallPathPointY <> nil then
begin
if CompareValue(GWallPathPointY.y, ActualPoints[PointCount].y, 1) = 0 then
ay := GWallPathPointY.Y;
if GWallPathPointX = nil then
begin
if CompareValue(GWallPathPointY.x, ActualPoints[PointCount].x, 1) = 0 then
ax := GWallPathPointY.x;
end;
end;
ActualPoints[PointCount] := DoublePoint(ax, ay);
end
else
begin
//distx := ABS(ActualPoints[PointCount - 1].x - x);
//disty := ABS(ActualPoints[PointCount - 1].y - y);
distx := ABS(ActualPoints[cIndex].x - x);
disty := ABS(ActualPoints[cIndex].y - y);
if CompareValue(distx, disty) = 1 then
ActualPoints[PointCount] := DoublePoint(x, ActualPoints[cIndex].y)
else
ActualPoints[PointCount] := DoublePoint(ActualPoints[cIndex].x, y);
if PointCount > 1 then
isVertical := (CompareValue(ActualPoints[PointCount].x, ActualPoints[PointCount - 1].x, 0.01) = 0);
ax := ActualPoints[PointCount].x;
ay := ActualPoints[PointCount].y;
if isVertical then
begin
if GWallPathPointX <> nil then
begin
if CompareValue(GWallPathPointX.x, ActualPoints[PointCount].x, 1) = 0 then
begin
ax := GWallPathPointX.x;
if PointCount > 1 then
ActualPoints[PointCount - 1] := DoublePoint(ax, ActualPoints[PointCount - 1].y);
end;
if GWallPathPointY = nil then
begin
if CompareValue(GWallPathPointX.y, ActualPoints[PointCount].y, 1) = 0 then
ay := GWallPathPointX.y;
end;
ActualPoints[PointCount] := DoublePoint(ax, ay);
end;
end
else
begin
if GWallPathPointY <> nil then
begin
if CompareValue(GWallPathPointY.y, ActualPoints[PointCount].y, 1) = 0 then
ay := GWallPathPointY.Y;
if PointCount > 1 then
ActualPoints[PointCount - 1] := DoublePoint(ActualPoints[PointCount - 1].x, ay);
if GWallPathPointX = nil then
begin
if CompareValue(GWallPathPointY.y, ActualPoints[PointCount].x, 1) = 0 then
ay := GWallPathPointX.x;
end;
end;
end;
ActualPoints[PointCount] := DoublePoint(ax, ay);
{
if PointCount > 2 then
begin
if checkNoConnectedPrevPoint then
begin
ax := ActualPoints[PointCount - 1].x;
ay := ActualPoints[PointCount - 1].y;
if isVertical then
ay := ActualPoints[PointCount].y
else
ax := ActualPoints[PointCount].x;
ActualPoints[PointCount - 1] := DoublePoint(ax, ay);
end;
end;
}
end;
end
else
begin
if Not (ssShift in GGlobalShiftState) then
begin
angle := 1 / tan(GDefaultAngle * pi / 180 / 2);
Len_X := abs(actualpoints[ClickIndex].X - X);
Len_Y := abs(actualpoints[ClickIndex].Y - Y);
if Len_X > Len_Y then
begin
if Len_X > angle * Len_Y then
Y := actualpoints[ClickIndex].Y
else
if Len_X < angle * Len_Y then
begin
if Y > actualpoints[ClickIndex].Y then
Y := actualpoints[ClickIndex].Y + Len_X
else
if Y < actualpoints[ClickIndex].Y then
Y := actualpoints[ClickIndex].Y - Len_X;
end;
end
else
if Len_X < Len_Y then
begin
if Len_Y > angle * Len_X then
X := actualpoints[ClickIndex].X
else
if Len_Y < angle * Len_X then
begin
if X > actualpoints[ClickIndex].X then
X := actualpoints[ClickIndex].X + Len_Y
else
if X < actualpoints[ClickIndex].X then
X := actualpoints[ClickIndex].X - Len_Y;
end;
end;
end;
SnapPoint(x, y);
actualpoints[PointCount] := DoublePoint(x, y);
end;
end;
procedure TWallPath.SnapPoint(var x, y: Double);
var
dx, dy, dpm: Double;
p1, p2: TDoublePoint;
wt: Double;
l, d, minD, dist: Double;
path: TnetPath;
begin
if not assigned(net) then
exit;
if not TPowercad(Net.Owner).SnapToNearPoint then
exit;
if Net.SnapToKnots(x, y, TPowercad(Net.Owner).DotsPerMil, False) then
exit;
if PointCount > 1 then
begin
p1 := actualpoints[PointCount - 1];
end
else
begin
path := Net.PointOnPath(DoublePoint(x, y));
if assigned(path) then
p1 := path.p1^
else
exit;
end;
dx := abs(p1.x - x);
dy := abs(p1.y - y);
if dx < dy then
begin
x := p1.x;
dx := 0;
end
else
begin
y := p1.y;
dy := 0;
end;
minD := 100 / Net.MapScale;
wt := net.WallThick;
if dy = 0 then
begin
d := dx;
d := d + wt;
l := Trunc(d / minD) * mind;
dist := d - l;
if dist >= (mind / 2) then
begin
l := l + MinD;
end;
l := l - wt;
if x > p1.x then
x := p1.x + l
else
x := p1.x - l;
end
else
if dx = 0 then
begin
d := abs(y - p1.y);
d := d + wt;
l := Trunc(d / minD) * mind;
dist := d - l;
if dist >= (mind / 2) then
begin
l := l + MinD;
end;
l := l - wt;
if y > p1.y then
y := p1.y + l
else
y := p1.y - l;
end;
if PointCount > 3 then
begin
p1 := actualpoints[1];
dx := GetLineLenght(p1, DoublePoint(x, y));
if dx < 6 then
begin
x := p1.x;
y := p1.y;
p2 := actualpoints[PointCount - 1];
dx := abs(p2.x - x);
dy := abs(p2.y - y);
if dx < 7 then
p2.x := x;
if dy < 7 then
p2.y := y;
actualpoints[PointCount - 1] := p2;
end;
end;
end;
{ TNetDoor }
procedure TNetDoor.CalculatePoints(xp1, xp2: TDoublePoint);
var
ww: Double;
begin
p1 := MPoint(xp1, xp2, Start);
p2 := MPoint(xp1, xp2, Start + Len);
ww := (Width / 2);
GetParallelPoints(p1, p2, a1, a2, -ww);
GetParallelPoints(p1, p2, b1, b2, ww);
GetParallelPoints(p1, p2, ca1, ca2, -0.5);
GetParallelPoints(p1, p2, cb1, cb2, 0.5);
//07.05.2012 - Îïðåäåëÿåì òî÷êè íèøè, ãäå óáèðàåòñÿ ëèíèÿ ñåãìåíòà
if DoorObjType = dotNiche then
begin
if FRotation = 0 then
begin
ClearP1 := b1;
ClearP2 := b2;
end
else
if FRotation = 1 then
begin
ClearP1 := a1;
ClearP2 := a2;
end;
end;
end;
constructor TNetDoor.Create(s, w, l: Double; aDoorObjType: TDoorObjType; xNet: Tnet);
begin
inherited create;
FComponID := 0;
FDeleting := false;
FPath := nil;
FOnDblClick := nil;
FOnDoorChangePathQuery := nil;
FOnDelete := nil;
FOnResize := nil;
FOnSelect := nil;
FRotation := 0;
FSrcDoor := nil;
// Tolik 15/09/2017 --
DoorImageType := dtSimple; // ïðîñòûå äâåðè
Mirrored := GArchEngine.GetLastObjParam(aoskPathDoorMirrored); // çåðêàëüíî (â äðóãóþ ñòîðîíó)
Doubled := GArchEngine.GetLastObjParam(aoskPathDoorDoubled); // äâîéíûå
LeftRight := GArchEngine.GetLastObjParam(aoskPathDoorLeftRight); // äâîñòîðîííèå äâåðè (åñëè ýòî äâåðè, à íå îêíî òàì èëè ÷òî-òî åùå)
Opened := GArchEngine.GetLastObjParam(aoskPathDoorOpened); // îòêðûòàÿ äâåðü
HalfOpened := GArchEngine.GetLastObjParam(aoskPathDoorHalfOpened);// ïîëóîòêðûòàÿ äâåðü
//
Net := xNet;
Start := s;
Width := w;
Len := l;
//Window := isWindow;
isDraw := True;
Region := 0;
DoorObjType := aDoorObjType;
if DoorObjType = dotWindow then
begin
//Tolik 25/08/2021 --
//WndPlacementHeight := MetreToUom(0.7);// Tolik 05/09/2018 -- âûñîòà ðàçìåùåíèÿ îêíà â ñòåíå ïî óìîë÷àíèþ -- 70 ñì.
//Height := MetreToUom(1.4); // âûñîòà îêíà
WndPlacementHeight := 0.7;// Tolik 05/09/2018 -- âûñîòà ðàçìåùåíèÿ îêíà â ñòåíå ïî óìîë÷àíèþ -- 70 ñì.
Height := 1.4; // âûñîòà îêíà
//
end
else
//if DoorObjType = dotDoor then
begin
// //Tolik 25/08/2021 --
//Height := MetreToUom(2); // âûñîòà äâåðè
//WndPlacementHeight := MetreToUom(0.1); // Tolik 05/09/2018 -- âûñîòà ðàçìåùåíèÿ äâåðè â ñòåíå ïî óìîë÷àíèþ -- 10 ñì.
Height := 2; // âûñîòà äâåðè
WndPlacementHeight := 0.1; // Tolik 05/09/2018 -- âûñîòà ðàçìåùåíèÿ äâåðè â ñòåíå ïî óìîë÷àíèþ -- 10 ñì.
//
end;
FIndent := 5;
//if isWindow then
//begin
// Height := 1300 / 50;
// WOffSet := 700 / 50;
//end
//else
//begin
// Height := 2000 / 50;
// WOffSet := 0;
//end;
SetDefParams;
GArchEngine.SetHandlersToObj(Self);
end;
class function TNetDoor.CreateFromStream(Stream: Tstream;xPath:TNetPath): TNetDoor;
var
DoorVersion, xByte: Byte;
begin
result := nil;
Stream.Read(DoorVersion, 1);
// DoorVersion = 1
Result := TNetDoor.Create(0, xPath.Width, 0, dotNone, xPath.net);
Stream.Read(Result.Start, 8);
Stream.Read(Result.FLen, 8);
Stream.Read(xByte, 1);
Result.Window := Bool(xByte);
//if Result.Window then
// Result.WOffset := 700 / 50
//else
// Result.WOffset := 0;
//if Result.Window then
// Result.Height := 1300 / 50
//else
// Result.Height := 2000 / 50;
Result.DefineDoorObjType;
Result.SetDefParams;
if (DoorVersion >= 2) then
begin
Stream.Read(Result.Height, 8);
Stream.Read(Result.WOffset, 8);
end;
//25.05.2010
if (DoorVersion >= 3) then
begin
Stream.Read(Result.FComponID, 4);
Stream.Read(xByte, 1);
Result.DoorObjType := TDoorObjType(xByte);
end;
//07.05.2012
if (DoorVersion >= 4) then
Stream.Read(Result.FRotation, 1);
// Tolik 15/09/2017 --
if DoorVersion >= 5 then
begin
Stream.Read(Byte(XByte), 1);
Result.DoorImageType := TDoorImageType(XByte);
Stream.Read(xByte, 1);
Result.Doubled := Bool(xByte);
Stream.Read(xByte, 1);
Result.Mirrored := Bool(xByte);
Stream.Read(xByte, 1);
Result.LeftRight := Bool(xByte);
Stream.Read(xByte, 1);
Result.Opened := Bool(xByte);
Stream.Read(xByte, 1);
Result.HalfOpened := Bool(xByte);
end;
// Tolik -- 06/09/2018 --
if DoorVersion >=6 then
Stream.Read(Result.WndPlacementHeight, 8) // âûñîòà ðàçìåùåíèÿ
else
begin
if Result.DoorObjType = dotDoor then
Result.WndPlacementHeight := MetreToUom(0.1) // äâåðü (ïîðîæåê)
else
Result.WndPlacementHeight := MetreToUom(0.7); // îêíî
end;
//
//
//GArchEngine.SetHandlersToObj(Result);
end;
procedure TNetDoor.DefineDoorObjType;
begin
if DoorObjType = dotNone then
begin
if Window then
DoorObjType := dotWindow
else
DoorObjType := dotDoor;
end
else
begin
Window := (DoorObjType = dotWindow);
end;
end;
procedure TNetDoor.DeleteRegion;
begin
if Region <> 0 then
DeleteObject(Region);
Region := 0;
end;
destructor TNetDoor.Destroy;
begin
if Region <> 0 then
DeleteObject(Region);
inherited;
end;
procedure TNetDoor.Draw(Dengine: TPCDrawEngine;Color:TColor);
var
Style: Integer;
DoorText: String;
p1, p2, p: TDoublePoint;
rad: Double;
// Tolik 17/09/2017 --
DoorMiddlePoint, DoorSide1Point, DoorSide2Point: TDoublePoint;
FullWidth, HalfWidth: Double; // øèðèíà è ïîëîâèíà øèðèíû äâåðè
ArcCenterPoint: TDoublePoint;
Reg: HRGN;
DoorAngle: Double;
//
begin
Style := ord(psSolid);
if Net.DrawAsTrace then
Style := ord(psDot);
// Åñëè îêíî, èëè äâåðü
if DoorObjType in [dotDoor, dotWindow, dotArc] then
begin
Dengine.drawline(a1,b1,Color,1,Style,0);
Dengine.drawline(a2,b2,Color,1,Style,0);
if Window then
begin
Dengine.drawline(a1,a2,Color,1,style,0);
Dengine.drawline(b1,b2,Color,1,style,0);
Dengine.drawline(ca1,ca2,Color,1,style,0);
Dengine.drawline(cb1,cb2,Color,1,style,0);
end
else if DoorObjType in [dotDoor, dotArc] then
begin
Dengine.drawline(ca1,ca2,Color,1,style,0);
Dengine.drawline(cb1,cb2,Color,1,style,0);
// Tolik --
if Doubled then // äâîéíàÿ äâåðü
begin
//DoorSide1Point := DoublePoint((a1.x + b1.x)/2, (a1.y + b1.y)/2); // ñðåäèíà îäíîé áîêîâóøêè
//DoorSide2Point := DoublePoint((a2.x + b2.x)/2, (a2.y + b2.y)/2); // ñðåäèíà âòîðîé áîêîâóøêè
//DoorMiddlePoint := DoublePoint((DoorSide1Point.x + DoorSide2Point.x)/2, (DoorSide1Point.y + DoorSide2Point.y)/2); // òî÷êà ïîñðåäèíå(ïî öåíòðó) äâåðè
//HalfWidth := Sqrt(sqr(a1.x - b1.x) + sqr(a1.y - b1.y))/2;// ïîëîâèíà øèðèíû äâåðíîãî ïðîåìà
//Dengine.drawline(DoublePoint(DoorMiddlePoint.x, DoorMiddlePoint.y - HalfWidth),DoublePoint(DoorMiddlePoint.x, DoorMiddlePoint.y + HalfWidth),Color,1,style,0);
if not Opened then // ïðîñòî äâîéíóþ -- ïåðå÷åðêèâàåì
if not HalfOpened then
Dengine.drawline(DoublePoint((a1.x + a2.x)/2, (a1.y + a2.y)/2),DoublePoint((b1.x + b2.x)/2, (b1.y + b2.y)/2),Color,1,style,0);
if Mirrored then // åñëè çåðêàëüíî
begin
// îòêðûòàÿ è ïîëóîòêðûòàÿ íàðèñóåòñÿ äîáàâëåíèåì àðîê è ëèíèé
if Opened then // åñëè ðèñîâàòü êàê îòêðûòóþ äâåðü (óãîë àðêè 90 ãðàäóñîâ)
begin
HalfWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y))/2;
DoorAngle := GetRadOfLine(ca1, ca2);
DoorMiddlePoint := DoublePoint((ca1.x + ca2.x)/2, (ca1.y + ca2.y)/2); // ñðåäèíà äâåðè
DEngine.drawbezarc(ca1.x, ca1.y, HalfWidth, DoorAngle + PI/2 - PI, DoorAngle, 0,1,0,0,0,0,reg, p1, p2, true,0);
Dengine.drawline(ca1,p1,Color,1,style,0);
DEngine.drawbezarc(ca2.x, ca2.y, HalfWidth, DoorAngle - PI, DoorAngle + PI/2 - PI, 0,1,0,0,0,0,reg, p1, p2, true,0);
Dengine.drawline(ca2,p2,Color,1,style,0);
end
else
if HalfOpened then // åñëè ðèñîâàòü êàê ïîëóîòêðûòóþ äâåðü (óãîë àðêè 45 ãðàäóñîâ)
begin
HalfWidth := Sqrt(sqr(cb1.x - cb2.x) + sqr(cb1.y - cb2.y))/2;
DoorAngle := GetRadOfLine(cb1, cb2);
DoorMiddlePoint := DoublePoint((cb1.x + cb2.x)/2, (cb1.y + cb2.y)/2); // ñðåäèíà äâåðè
DEngine.drawbezarc(cb1.x, cb1.y, HalfWidth, DoorAngle + PI/4 - PI/2, DoorAngle, 0,1,0,0,0,0,reg, p1, p2, true,0);
//p1 := RotateDPoint(cb1, DoorMiddlePoint, DoorAngle + PI/4);
//Dengine.drawline(cb1,p1,Color,1,style,0);
Dengine.drawline(cb1,p1,Color,1,style,0);
DEngine.drawbezarc(cb2.x, cb2.y, HalfWidth, DoorAngle + PI,DoorAngle + PI + PI/4, 0,1,0,0,0,0,reg, p1, p2, true,0);
//p1 := RotateDPoint(cb2, DoorMiddlePoint, DoorAngle - PI/4);
//Dengine.drawline(cb2,p1,Color,1,style,0);
Dengine.drawline(cb2,p2,Color,1,style,0);
end;
end
else
begin
// îòêðûòàÿ è ïîëóîòêðûòàÿ íàðèñóåòñÿ äîáàâëåíèåì àðîê è ëèíèé
if Opened then // åñëè ðèñîâàòü êàê îòêðûòóþ äâåðü (óãîë àðêè 90 ãðàäóñîâ)
begin
HalfWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y))/2;
DoorAngle := GetRadOfLine(ca1, ca2);
DoorMiddlePoint := DoublePoint((ca1.x + ca2.x)/2, (ca1.y + ca2.y)/2); // ñðåäèíà äâåðè
DEngine.drawbezarc(ca1.x, ca1.y, HalfWidth, DoorAngle, DoorAngle + PI/2, 0,1,0,0,0,0,reg, p1, p2, true,0);
//p1 := RotateDPoint(ca1, DoorMiddlePoint, DoorAngle + PI/2);
//Dengine.drawline(ca1,p1,Color,1,style,0);
Dengine.drawline(ca1,p2,Color,1,style,0);
DEngine.drawbezarc(ca2.x, ca2.y, HalfWidth, DoorAngle - PI - PI/2, DoorAngle - PI, 0,1,0,0,0,0,reg, p1, p2, true,0);
//p1 := RotateDPoint(ca2, DoorMiddlePoint, DoorAngle - PI/2);
//Dengine.drawline(ca2,p1,Color,1,style,0);
Dengine.drawline(ca2,p1,Color,1,style,0);
end
else
if HalfOpened then // åñëè ðèñîâàòü êàê ïîëóîòêðûòóþ äâåðü (óãîë àðêè 45 ãðàäóñîâ)
begin
HalfWidth := Sqrt(sqr(cb1.x - cb2.x) + sqr(cb1.y - cb2.y))/2;
DoorAngle := GetRadOfLine(cb1, cb2);
DoorMiddlePoint := DoublePoint((cb1.x + cb2.x)/2, (cb1.y + cb2.y)/2); // ñðåäèíà äâåðè
DEngine.drawbezarc(cb1.x, cb1.y, HalfWidth, DoorAngle , DoorAngle + PI/4, 0,1,0,0,0,0,reg, p1, p2, true,0);
//p1 := RotateDPoint(cb1, DoorMiddlePoint, DoorAngle + PI/4);
//Dengine.drawline(cb1,p1,Color,1,style,0);
Dengine.drawline(cb1,p2,Color,1,style,0);
DEngine.drawbezarc(cb2.x, cb2.y, HalfWidth, DoorAngle - PI - PI/4, DoorAngle - PI, 0,1,0,0,0,0,reg, p1, p2, true,0);
//p1 := RotateDPoint(cb2, DoorMiddlePoint, DoorAngle - PI/4);
//Dengine.drawline(cb2,p1,Color,1,style,0);
Dengine.drawline(cb2,p1,Color,1,style,0);
end;
end;
end
else // ïðîñòàÿ (íå äâîéíàÿ äâåðü)
begin
if not Mirrored then // íå çåðêàëüíî
begin
if not LeftRight then //ëåâîñòîðîííÿÿ äâåðü
begin
if Opened then // åñëè ðèñîâàòü êàê îòêðûòóþ äâåðü
begin
FullWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y));
DoorAngle := GetRadOfLine(ca1, ca2);
//DEngine.drawbezarc(ca1.x, ca1.y, FullWidth, DoorAngle, DoorAngle + PI/2, 0,1,0,0,0,0,reg, p1, p2, true,0);
//Dengine.drawline(ca1,p2,Color,1,style,0);
DEngine.drawbezarc(ca2.x, ca2.y, FullWidth, DoorAngle - PI - PI/2, DoorAngle - PI, 0,1,0,0,0,0,reg, p1, p2, true,0);
Dengine.drawline(ca2,p1,Color,1,style,0);
end
else
if HalfOpened then // åñëè ðèñîâàòü êàê ïîëóîòêðûòóþ äâåðü
begin
FullWidth := Sqrt(sqr(cb1.x - cb2.x) + sqr(cb1.y - cb2.y));
DoorAngle := GetRadOfLine(cb1, cb2);
DEngine.drawbezarc(cb2.x, cb2.y, FullWidth, DoorAngle - PI - PI/4, DoorAngle - PI, 0,1,0,0,0,0,reg, p1, p2, true,0);
Dengine.drawline(cb2,p1,Color,1,style,0);
end;
end
else // ïðàâîñòîðîííÿÿ äâåðü
begin
if Opened then // åñëè ðèñîâàòü êàê îòêðûòóþ äâåðü
begin
FullWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y));
DoorAngle := GetRadOfLine(ca1, ca2);
DEngine.drawbezarc(ca1.x, ca1.y, FullWidth, DoorAngle, DoorAngle + PI/2, 0,1,0,0,0,0,reg, p1, p2, true,0);
Dengine.drawline(ca1,p2,Color,1,style,0);
end
else
if HalfOpened then // åñëè ðèñîâàòü êàê ïîëóîòêðûòóþ äâåðü
begin
FullWidth := Sqrt(sqr(cb1.x - cb2.x) + sqr(cb1.y - cb2.y));
DoorAngle := GetRadOfLine(cb1, cb2);
DEngine.drawbezarc(cb1.x, cb1.y, FullWidth,DoorAngle , DoorAngle + PI/4, 0,1,0,0,0,0,reg, p1, p2, true,0);
Dengine.drawline(cb1,p2,Color,1,style,0);
end;
end;
end
else
begin // Çåðêàëüíî
if not LeftRight then //ëåâîñòîðîííÿÿ äâåðü
begin
if Opened then // åñëè ðèñîâàòü êàê îòêðûòóþ äâåðü
begin
FullWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y));
DoorAngle := GetRadOfLine(ca1, ca2);
DEngine.drawbezarc(ca2.x, ca2.y, FullWidth, DoorAngle + PI, DoorAngle - PI/2, 0,1,0,0,0,0,reg, p1, p2, true,0);
Dengine.drawline(ca2,p2,Color,1,style,0);
end
else
if HalfOpened then // åñëè ðèñîâàòü êàê ïîëóîòêðûòóþ äâåðü
begin
FullWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y));
DoorAngle := GetRadOfLine(ca1, ca2);
DEngine.drawbezarc(ca2.x, ca2.y, FullWidth, DoorAngle + PI, DoorAngle - PI/2 - PI/4, 0,1,0,0,0,0,reg, p1, p2, true,0);
Dengine.drawline(ca2,p2,Color,1,style,0);
end;
end
else // ïðàâîñòîðîííÿÿ äâåðü
begin
if Opened then // åñëè ðèñîâàòü êàê îòêðûòóþ äâåðü
begin
FullWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y));
DoorAngle := GetRadOfLine(ca1, ca2);
DEngine.drawbezarc(ca1.x, ca1.y, FullWidth, DoorAngle - PI/2, DoorAngle, 0,1,0,0,0,0,reg, p1, p2, true,0);
Dengine.drawline(ca1,p1,Color,1,style,0);
end
else
if HalfOpened then // åñëè ðèñîâàòü êàê ïîëóîòêðûòóþ äâåðü
begin
FullWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y));
DoorAngle := GetRadOfLine(ca1, ca2);
DEngine.drawbezarc(ca1.x, ca1.y, FullWidth,DoorAngle - PI/4, DoorAngle, 0,1,0,0,0,0,reg, p1, p2, true,0);
Dengine.drawline(ca1,p1,Color,1,style,0);
end;
end;
end;
end;
//
if (DoorType = dtOutDoor) and (DoorNbr <> 0) and (DoorNbr <> 9000) then
begin
if DoorNbr < 9000 then
begin
DoorText := '< 9000 '+ inttostr(DoorNbr);
end
else
begin
DoorText := '>= 9000 '+ inttostr(DoorNbr - 9000);
end;
p1 := Mpoint(a1,a2);
p2 := Mpoint(b1,b2);
ExtendLine(p1,p2,5.0);
if InSide = 0 then
p := p1
else
p := p2;
rad := GetRadOfLine(a1,a2);
Dengine.DrawCenteredtext(p, color, DoorText, 'Tahoma', 3.0, Rad);
end;
end;
end
// Ïðîåì
else if DoorObjType in [dotEmbrasure, dotBalcony] then
begin
Dengine.drawline(a1,b1,Color,1,Style,0);
Dengine.drawline(a2,b2,Color,1,Style,0);
Dengine.drawline(a1,a2,Color,1,style,0);
Dengine.drawline(b1,b2,Color,1,style,0);
if DoorObjType = dotBalcony then
begin
FIndent := 5;
//if a2.x < a1.x then
// Indent := Indent * -1;
// Áîêîâóøêè
GetParallelPoints(a1, b1, p1, p2, FIndent * -1);
Dengine.drawline(p1, p2, Color,1,Style,0);
GetParallelPoints(a2, b2, p1, p2, FIndent);
Dengine.drawline(p1, p2, Color,1,Style,0);
// äâîéíàÿ ëèíèÿ ïî ñðåäèíå ñåãìåíòà ìåæäó áîêîâóøêàìè
GetShrinkedPoints(ca1, ca2, p1, p2, FIndent);
Dengine.drawline(p1,p2,Color,1,style,0);
GetShrinkedPoints(cb1, cb2, p1, p2, FIndent);
Dengine.drawline(p1,p2,Color,1,style,0);
//Dengine.drawline(DoublePoint(a1.x+Indent, a1.y), DoublePoint(b1.x+Indent, b1.y), Color,1,Style,0);
//Dengine.drawline(DoublePoint(a2.x-Indent, a2.y), DoublePoint(b2.x-Indent, b2.y), Color,1,Style,0);
end;
end
// Íèøà
else if DoorObjType = dotNiche then
begin
{// óãëóáëåíèå íèøû
Dengine.drawline(ca1,b1,Color,1,Style,0);
Dengine.drawline(ca2,b2,Color,1,Style,0);
Dengine.drawline(ca1,ca2,Color,1,style,0);
// Áåëûì öâåòîì ñëèâàåì ñòåíó íèøè ñ ïðåëåãàþùåé ñòåíîé
Dengine.drawline(ca1,a1,clWhite,1,Style,0);
Dengine.drawline(ca2,a2,clWhite,1,Style,0);
// ñòåíà íèøè
Dengine.drawline(a1,a2,Color,1,style,0);}
if FRotation = 0 then
DrawNiche(Dengine, Color, Style, @a1,@a2, @b1,@b2, @ca1,@ca2)
else
if FRotation = 1 then
DrawNiche(Dengine, Color, Style, @b1,@b2, @a1,@a2, @cb1,@cb2);
end;
end;
Procedure TNetDoor.DrawNiche(Dengine: TPCDrawEngine; Color: TColor; aStyle: Integer; pa1, pa2, pb1, pb2, cp1, cp2: PDoublePoint);
begin
// óãëóáëåíèå íèøû
Dengine.drawline(cp1^,pb1^,Color,1,aStyle,0);
Dengine.drawline(cp2^,pb2^,Color,1,aStyle,0);
Dengine.drawline(cp1^,cp2^,Color,1,astyle,0);
// Áåëûì öâåòîì ñëèâàåì ñòåíó íèøè ñ ïðåëåãàþùåé ñòåíîé
Dengine.drawline(cp1^,pa1^,clWhite,1,aStyle,0);
Dengine.drawline(cp2^,pa2^,clWhite,1,aStyle,0);
// ñòåíà íèøè
Dengine.drawline(pa1^,pa2^,Color,1,aStyle,0);
{// óãëóáëåíèå íèøû
Dengine.drawline(cb1,a1,Color,1,Style,0);
Dengine.drawline(cb2,a2,Color,1,Style,0);
Dengine.drawline(cb1,cb2,Color,1,style,0);
// Áåëûì öâåòîì ñëèâàåì ñòåíó íèøè ñ ïðåëåãàþùåé ñòåíîé
Dengine.drawline(cb1,b1,clWhite,1,Style,0);
Dengine.drawline(cb2,b2,clWhite,1,Style,0);
// ñòåíà íèøè
Dengine.drawline(b1,b2,Color,1,style,0);}
end;
procedure TNetDoor.GetInPoints(var top1, top2, bot1, bot2: TDoublePoint;
PathDir: Integer);
begin
if PathDir = 2 then
begin
top1 := ta1;
top2 := ta2;
bot1 := ba1;
bot2 := ba2;
end
else
begin
top1 := tb1;
top2 := tb2;
bot1 := bb1;
bot2 := bb2;
end;
end;
procedure TNetDoor.GetOutPoints(var top1, top2, bot1, bot2: TDoublePoint;
PathDir: Integer);
begin
if PathDir = 1 then
begin
top1 := ta1;
top2 := ta2;
bot1 := ba1;
bot2 := ba2;
end
else
begin
top1 := tb1;
top2 := tb2;
bot1 := bb1;
bot2 := bb2;
end;
end;
procedure TNetDoor.UpdateRegion(Dengine: TPCDrawEngine);
var
pArr: TDoublePointArr;
begin
if Region <> 0 then
DeleteObject(Region);
SetLength(pArr, 4);
pArr[0] := a1;
pArr[1] := a2;
pArr[2] := b2;
pArr[3] := b1;
Region := Dengine.PolygonRegion(pArr);
end;
procedure TNetDoor.SetDefParams;
begin
if DoorObjType = dotWindow then
begin
//Height := 1300 / 50; // Tolik 06/09/2018 --
WOffSet := 700 / 50;
Window := true;
end
else
begin
//Height := 2000 / 50; // Tolik 06/09/2018 --
WOffSet := 0;
Window := false;
end;
end;
procedure TNetDoor.WriteToStream(Stream: TStream);
var
DoorVersion, XByte: Byte;
begin
//DoorVersion := 2; //25.05.2010
//DoorVersion := 3; //25.05.2010
//DoorVersion := 4; //07.05.2012
//DoorVersion := 5; // Tolik -- 21/09/2017 --
DoorVersion := 6; // Tolik 05/09/2018 --
Stream.Write(DoorVersion, 1);
Stream.Write(Start, 8);
Stream.Write(Len, 8);
Stream.Write(Byte(Window), 1);
Stream.Write(Height, 8);
Stream.Write(WOffSet, 8);
Stream.Write(FComponID, 4); //25.05.2010
XByte := Ord(DoorObjType);
Stream.Write(Byte(XByte), 1);
Stream.Write(FRotation, 1);
// Tolik 15/09/2017 --
XByte := Ord(DoorImageType);
Stream.Write(Byte(XByte), 1);
Stream.Write(Byte(Doubled), 1);
Stream.Write(Byte(Mirrored), 1);
Stream.Write(Byte(LeftRight), 1);
Stream.Write(Byte(Opened), 1);
Stream.Write(Byte(HalfOpened), 1);
//
Stream.Write(WndPlacementHeight, 8); // Tolik 06/09/2018 -- âûñîòà ðàçìåùåíèÿ îêíà
end;
procedure TNetDoor.DoClick;
begin
if Assigned(FOnSelect) then
FOnSelect(Self);
end;
procedure TNetDoor.DoDblClick;
begin
if Assigned(FOnDblClick) then
FOnDblClick(Self);
end;
procedure TNetDoor.DoDelete;
begin
if Not FDeleting then
begin
FDeleting := true;
if Assigned(FOnDelete) then
FOnDelete(Self);
end;
end;
procedure TNetDoor.DoResize;
begin
if Assigned(FOnResize) then
FOnResize(Self);
end;
function TNetDoor.DoChangePathQuery(APath, ANewPath: TNetPath): Boolean;
begin
Result := true;
if Assigned(FOnDoorChangePathQuery) then
FOnDoorChangePathQuery(Self, APath, ANewPath, Result);
end;
function TNetDoor.GetPath: TNetPath;
var
i: Integer;
Path: TNetPath;
begin
Result := nil;
if Net <> nil then
begin
for i := 0 to Net.Paths.Count - 1 do
begin
Path := TNetPath(Net.Paths[i]);
if Path.Doors.IndexOf(Self) <> -1 then
begin
Result := Path;
Break; //// BREAK ////
end;
end;
end;
end;
procedure TNetDoor.TestSetVal(AValue: Double);
begin
FLen := AValue;
end;
{ TNetStruct }
constructor TNetStruct.Create(xNet: TNet);
begin
inherited Create;
Net := xnet;
Region := 0;
Points := TList.Create;
end;
class function TNetStruct.CreateFromStream(Stream: Tstream;
xNet: Tnet): TNetStruct;
var
classIndex: Byte;
begin
result := nil;
Stream.Read(ClassIndex, 1);
if ClassIndex = 1 then
begin
result := TNetCol.CreateFromStream(Stream, xNet);
end
else
if ClassIndex = 2 then
begin
result := TNetRow.CreateFromStream(Stream, xNet);
end;
end;
destructor TNetStruct.Destroy;
begin
if Region <> 0 then
DeleteObject(Region);
Points.Free;
inherited Destroy;
end;
procedure TNetStruct.DoSolid(Faces: Tlist; topZ, botZ: Double);
begin
end;
procedure TNetStruct.Draw(Dengine: TPCdrawEngine;isGrayed:Boolean);
begin
//
end;
procedure TNetStruct.DrawGuides(DEngine: TPCDrawEngine);
begin
end;
procedure TNetStruct.DrawTrace(Dengine: TPCDrawEngine);
begin
end;
function TNetStruct.Duplicate: TNetStruct;
begin
result := nil;
end;
function TNetStruct.DuplicateNonPoints: TNetStruct;
begin
result := nil;
end;
procedure TNetStruct.GetBounds(var figMaxX, figMaxY, figMinX,
figMinY: Double);
begin
end;
function TNetStruct.GetDistToPoint(p: TDoublePoint): Double;
begin
end;
procedure TNetStruct.Hatch(Dengine: TPCdrawEngine; isGrayed: Boolean);
begin
if Region <> 0 then
begin
DEngine.Canvas.Brush.Style := bsFDiagonal;
if isGrayed then
DEngine.Canvas.Brush.Color := clSilver
else
DEngine.Canvas.Brush.Color := clGreen;
FillRgn(Dengine.Canvas.Handle,Region,DEngine.Canvas.Brush.Handle);
end;
end;
function TNetStruct.IsKnotIn(p: PDoublePoint): Integer;
begin
result := -1;
result := Points.IndexOf(p);
end;
function TNetStruct.IsPointIn(x,y:Double): Boolean;
var
dx, dy, z: Double;
begin
result := false;
if region <> 0 then
begin
if assigned(Net.XDrawEngine) then
begin
dx := x;
dy := y;
z := 0;
Net.XDrawEngine.ConvertPoint(dx, dy, z);
result := ptInRegion(Region, round(dx), round(dy));
end;
end;
end;
function TNetStruct.PathInter(p1, p2: TDoublePoint): Boolean;
begin
result := false;
end;
procedure TNetStruct.PropUpdate(PropName, PropVal: String);
begin
end;
procedure TNetStruct.ShowProperties;
begin
end;
function TNetStruct.SnapPoints(var x, y: Double;
DotsPerMil: Double): Boolean;
begin
result := false;
end;
procedure TNetStruct.WriteToStream(Stream: TStream);
begin
///
end;
{ TNetCol }
constructor TNetCol.Create(xNet: Tnet; p: PDoublePoint);
begin
inherited Create(xNet);
p1 := p;
Points.Add(p1);
w := 12;
h := 12;
Angle := 0;
end;
class function TNetCol.CreateFromStream(Stream: Tstream;
xNet: Tnet): TNetStruct;
var
colVersion:Byte;
i: Integer;
xCol: TnetCol;
begin
result := nil;
xCol := TNetCol.Create(xNet,nil);
xCol.Points.Clear;
Stream.Read(colversion,1);
// colversion = 1;
Stream.Read(i,4);
if (i > -1) and (i<xNet.Points.Count) then
begin
xCol.p1 := xNet.Points[i];
xCol.Points.Add(xCol.p1);
end
else
begin
xCol.Free;
result := nil;
exit;
end;
Stream.Read(xCol.w,8);
Stream.Read(xCol.h,8);
Stream.Read(xCol.Angle,8);
Stream.Read(xCol.Position,1);
Result := xCol;
end;
procedure TNetCol.Draw(Dengine: TPCdrawEngine;isGrayed:Boolean);
var
color: Integer;
x1,y1,x2,y2: Double;
ap1,ap2,ap3,ap4: TDoublePoint;
begin
if isGrayed then
Color := clSilver
else
Color := clBlack;
_Draw(Dengine,Color,true);
end;
procedure TNetCol.DrawGuides(DEngine: TPCDrawEngine);
var
ap1,ap2,ap3,ap4: TDoublePoint;
begin
GetPipePoints(ap1,ap2,ap3,ap4);
Dengine.DrawPoint(ap1,clSilver);
Dengine.DrawPoint(ap2,clSilver);
Dengine.DrawPoint(ap3,clSilver);
Dengine.DrawPoint(ap4,clSilver);
end;
procedure TNetCol.DrawTrace(Dengine: TPCDrawEngine);
begin
_Draw(Dengine,clLime,false);
end;
function TNetCol.DuplicateNonPoints: TNetStruct;
begin
result := nil;
result := TnetCol.Create(Net, nil);
result.Points.Clear;
TnetCol(result).w := w;
TnetCol(result).h := h;
TnetCol(result).Position := Position;
TnetCol(result).Angle := Angle;
end;
procedure TNetCol.GetBounds(var figMaxX, figMaxY, figMinX,
figMinY: Double);
var
xp1,xp2,xp3,xp4: TDoublePoint;
begin
GetPoints(xp1,xp2,xp3,xp4);
figMaxX := xp1.x;
figMaxY := xp1.y;
figMinX := xp1.x;
figMinY := xp1.y;
if xp2.x > figMaxX then
figMaxX := xp2.x;
if xp3.x > figMaxX then
figMaxX := xp3.x;
if xp4.x > figMaxX then
figMaxX := xp4.x;
if xp2.x < figMinX then
figMinX := xp2.x;
if xp3.x < figMinX then
figMinX := xp3.x;
if xp4.x < figMinX then
figMinX := xp4.x;
if xp2.y > figMaxY then
figMaxY := xp2.y;
if xp3.y > figMaxY then
figMaxY := xp3.y;
if xp4.y > figMaxY then
figMaxY := xp4.y;
if xp2.y < figMinY then
figMinY := xp2.y;
if xp3.y < figMinY then
figMinY := xp3.y;
if xp4.y < figMinY then
figMinY := xp4.y;
end;
function TNetCol.GetDistToPoint(p: TDoublePoint): Double;
var
xp,xp1,xp2,xp3,xp4: TDoublePoint;
dist: Double;
begin
result := 0;
GetPoints(xp1,xp2,xp3,xp4);
xp := p;
PointToLine(xp1,xp2,xp.x,xp.y);
dist := GetLineLength(xp,p);
result := dist;
xp := p;
PointToLine(xp2,xp3,xp.x,xp.y);
dist := GetLineLength(xp,p);
if dist < result then
result := dist;
xp := p;
PointToLine(xp3,xp4,xp.x,xp.y);
dist := GetLineLength(xp,p);
if dist < result then
result := dist;
xp := p;
PointToLine(xp4,xp1,xp.x,xp.y);
dist := GetLineLength(xp,p);
if dist < result then
result := dist;
end;
function TNetCol.GetPipePoints(var ap1, ap2, ap3,
ap4: TDoublePoint): Boolean;
var
xp1,xp2,xp3,xp4: TDoublePoint;
begin
result := false;
GetPoints(xp1,xp2,xp3,xp4);
ap1 := MPoint(xp1,xp2,-1.0);
ap2 := MPoint(xp2,xp1,-1.0);
ap3 := MPoint(xp3,xp4,-1.0);
ap4 := MPoint(xp4,xp3,-1.0);
ap1 := MPoint(ap1,ap4,-1.0);
ap4 := MPoint(ap4,ap1,-1.0);
ap2 := MPoint(ap2,ap3,-1.0);
ap3 := MPoint(ap3,ap2,-1.0);
end;
Function TNetCol.GetPoints(var ap1,ap2, ap3, ap4: TDoublePoint):Boolean;
var
dx,dy,delta: Double;
begin
result := false;
if (not assigned(p1)) and (Points.Count > 0) then
p1 := PDoublePoint(Points[0]);
if (not assigned(p1)) then
exit;
ap1 := DoublePoint(p1^.x - (w / 2),p1^.y - (h / 2));
ap2 := DoublePoint(p1^.x + (w / 2),p1^.y - (h / 2));
ap3 := DoublePoint(p1^.x + (w / 2),p1^.y + (h / 2));
ap4 := DoublePoint(p1^.x - (w / 2),p1^.y + (h / 2));
dx := 0;
dy := 0;
if Position in [1,8,7] then
dx := w / 2;
if Position in [3,4,5] then
dx := -w / 2;
if Position in [1,2,3] then
dy := h / 2;
if Position in [7,6,5] then
dy := -h / 2;
delta := (net.WallThick / 2);//-0.4;
if dx <> 0 then
begin
if dx > 0 then
delta := -delta;
dx := dx + delta;
end;
delta := (net.WallThick / 2);//-0.4;
if dy <> 0 then
begin
if dy > 0 then
delta := -delta;
dy := dy + delta;
end;
ap1 := MovePoint(ap1,dx,dy);
ap2 := MovePoint(ap2,dx,dy);
ap3 := MovePoint(ap3,dx,dy);
ap4 := MovePoint(ap4,dx,dy);
ap1 := RotatePoint(p1^,ap1,Angle);
ap2 := RotatePoint(p1^,ap2,Angle);
ap3 := RotatePoint(p1^,ap3,Angle);
ap4 := RotatePoint(p1^,ap4,Angle);
result := True;
end;
procedure TNetCol.IntersectPath(Path: TnetPath);
var
ap1,ap2, ap3, ap4,ip,xp,ip1,ip2: TDoublePoint;
radius: Double;
iCnt: Integer;
begin
GetPoints(ap1,ap2,ap3,ap4);
if not path.isArc then
begin
if GetIntersectionPoint(path.l1,path.l2,ap1,ap2,ip,false,true) then
begin
if path.dir = 1 then
path.l1 := ip
else
path.l2 := ip;
end;
if GetIntersectionPoint(path.l1,path.l2,ap2,ap3,ip,false,true) then
begin
if path.dir = 1 then
path.l1 := ip
else
path.l2 := ip;
end;
if GetIntersectionPoint(path.l1,path.l2,ap3,ap4,ip,false,true) then
begin
if path.dir = 1 then
path.l1 := ip
else
path.l2 := ip;
end;
if GetIntersectionPoint(path.l1,path.l2,ap4,ap1,ip,false,true) then
begin
if path.dir = 1 then
path.l1 := ip
else
path.l2 := ip;
end;
if GetIntersectionPoint(path.r1,path.r2,ap1,ap2,ip,false,true) then
begin
if path.dir = 1 then
path.r1 := ip
else
path.r2 := ip;
end;
if GetIntersectionPoint(path.r1,path.r2,ap2,ap3,ip,false,true) then
begin
if path.dir = 1 then
path.r1 := ip
else
path.r2 := ip;
end;
if GetIntersectionPoint(path.r1,path.r2,ap3,ap4,ip,false,true) then
begin
if path.dir = 1 then
path.r1 := ip
else
path.r2 := ip;
end;
if GetIntersectionPoint(path.r1,path.r2,ap4,ap1,ip,false,true) then
begin
if path.dir = 1 then
path.r1 := ip
else
path.r2 := ip;
end;
end
else
begin
if path.Dir = 1 then
xp := path.l2
else
xp := path.l1;
radius := GetLineLenght(xp,path.ArcCenter);
if GetLineCircleIntersection(ap1,ap2,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap2,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.l1,path.l2,path.Inverted) then
if path.Dir = 1 then
begin
path.l1 := ip;
path.ArcJoinA1 := ip;
path.ArcJoinA1L := ip;
end
else
begin
path.l2 := ip;
path.ArcJoinA2 := ip;
path.ArcJoinA2L := ip;
end;
end;
if GetLineCircleIntersection(ap2,ap3,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap3,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.l1,path.l2,path.Inverted) then
if path.Dir = 1 then
begin
path.l1 := ip;
path.ArcJoinA1 := ip;
path.ArcJoinA1L := ip;
end
else
begin
path.l2 := ip;
path.ArcJoinA2 := ip;
path.ArcJoinA2L := ip;
end;
end;
if GetLineCircleIntersection(ap3,ap4,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap4,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.l1,path.l2,path.Inverted) then
if path.Dir = 1 then
begin
path.l1 := ip;
path.ArcJoinA1 := ip;
path.ArcJoinA1L := ip;
end
else
begin
path.l2 := ip;
path.ArcJoinA2 := ip;
path.ArcJoinA2L := ip;
end;
end;
if GetLineCircleIntersection(ap4,ap1,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap1,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.l1,path.l2,path.Inverted) then
if path.Dir = 1 then
begin
path.l1 := ip;
path.ArcJoinA1 := ip;
path.ArcJoinA1L := ip;
end
else
begin
path.l2 := ip;
path.ArcJoinA2 := ip;
path.ArcJoinA2L := ip;
end;
end;
if path.Dir = 1 then
xp := path.r2
else
xp := path.r1;
radius := GetLineLenght(xp,path.ArcCenter);
if GetLineCircleIntersection(ap1,ap2,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap2,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.r1,path.r2,path.Inverted) then
if path.Dir = 1 then
begin
path.r1 := ip;
path.ArcJoinB1 := ip;
path.ArcJoinB1L := ip;
end
else
begin
path.r2 := ip;
path.ArcJoinB2 := ip;
path.ArcJoinB2L := ip;
end;
end;
if GetLineCircleIntersection(ap2,ap3,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap3,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.r1,path.r2,path.Inverted) then
if path.Dir = 1 then
begin
path.r1 := ip;
path.ArcJoinB1 := ip;
path.ArcJoinB1L := ip;
end
else
begin
path.r2 := ip;
path.ArcJoinB2 := ip;
path.ArcJoinB2L := ip;
end;
end;
if GetLineCircleIntersection(ap3,ap4,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap4,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.r1,path.r2,path.Inverted) then
if path.Dir = 1 then
begin
path.r1 := ip;
path.ArcJoinB1 := ip;
path.ArcJoinB1L := ip;
end
else
begin
path.r2 := ip;
path.ArcJoinB2 := ip;
path.ArcJoinB2L := ip;
end;
end;
if GetLineCircleIntersection(ap4,ap1,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap1,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.r1,path.r2,path.Inverted) then
if path.Dir = 1 then
begin
path.r1 := ip;
path.ArcJoinB1 := ip;
path.ArcJoinB1L := ip;
end
else
begin
path.r2 := ip;
path.ArcJoinB2 := ip;
path.ArcJoinB2L := ip;
end;
end;
end;
end;
procedure TNetCol.IntersectPathPipe(Path: TnetPath);
var
ap1,ap2, ap3, ap4,ip,xp,ip1,ip2: TDoublePoint;
radius: Double;
iCnt: Integer;
begin
GetPipePoints(ap1,ap2,ap3,ap4);
if not path.isArc then
begin
if GetIntersectionPoint(path.hl1,path.hl2,ap1,ap2,ip,false,true) then
begin
if path.dir = 1 then
path.hl1 := ip
else
path.hl2 := ip;
end;
if GetIntersectionPoint(path.hl1,path.hl2,ap2,ap3,ip,false,true) then
begin
if path.dir = 1 then
path.hl1 := ip
else
path.hl2 := ip;
end;
if GetIntersectionPoint(path.hl1,path.hl2,ap3,ap4,ip,false,true) then
begin
if path.dir = 1 then
path.hl1 := ip
else
path.hl2 := ip;
end;
if GetIntersectionPoint(path.hl1,path.hl2,ap4,ap1,ip,false,true) then
begin
if path.dir = 1 then
path.hl1 := ip
else
path.hl2 := ip;
end;
if GetIntersectionPoint(path.hr1,path.hr2,ap1,ap2,ip,false,true) then
begin
if path.dir = 1 then
path.hr1 := ip
else
path.hr2 := ip;
end;
if GetIntersectionPoint(path.hr1,path.hr2,ap2,ap3,ip,false,true) then
begin
if path.dir = 1 then
path.hr1 := ip
else
path.hr2 := ip;
end;
if GetIntersectionPoint(path.hr1,path.hr2,ap3,ap4,ip,false,true) then
begin
if path.dir = 1 then
path.hr1 := ip
else
path.hr2 := ip;
end;
if GetIntersectionPoint(path.hr1,path.hr2,ap4,ap1,ip,false,true) then
begin
if path.dir = 1 then
path.hr1 := ip
else
path.hr2 := ip;
end;
end
else
begin
if path.Dir = 1 then
xp := path.hl2
else
xp := path.hl1;
radius := GetLineLenght(xp,path.ArcCenter);
if GetLineCircleIntersection(ap1,ap2,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap2,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.hl1,path.hl2,path.Inverted) then
if path.Dir = 1 then
begin
path.hl1 := ip;
end
else
begin
path.hl2 := ip;
end;
end;
if GetLineCircleIntersection(ap2,ap3,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap3,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.hl1,path.hl2,path.Inverted) then
if path.Dir = 1 then
begin
path.hl1 := ip;
end
else
begin
path.hl2 := ip;
end;
end;
if GetLineCircleIntersection(ap3,ap4,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap4,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.hl1,path.hl2,path.Inverted) then
if path.Dir = 1 then
begin
path.hl1 := ip;
end
else
begin
path.hl2 := ip;
end;
end;
if GetLineCircleIntersection(ap4,ap1,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap1,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.hl1,path.hl2,path.Inverted) then
if path.Dir = 1 then
begin
path.hl1 := ip;
end
else
begin
path.hl2 := ip;
end;
end;
if path.Dir = 1 then
xp := path.hr2
else
xp := path.hr1;
radius := GetLineLenght(xp,path.ArcCenter);
if GetLineCircleIntersection(ap1,ap2,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap2,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.hr1,path.hr2,path.Inverted) then
if path.Dir = 1 then
begin
path.hr1 := ip;
end
else
begin
path.hr2 := ip;
end;
end;
if GetLineCircleIntersection(ap2,ap3,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap3,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.hr1,path.hr2,path.Inverted) then
if path.Dir = 1 then
begin
path.hr1 := ip;
end
else
begin
path.hr2 := ip;
end;
end;
if GetLineCircleIntersection(ap3,ap4,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap4,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.hr1,path.hr2,path.Inverted) then
if path.Dir = 1 then
begin
path.hr1 := ip;
end
else
begin
path.hr2 := ip;
end;
end;
if GetLineCircleIntersection(ap4,ap1,path.ArcCenter,radius,ip1,ip2,iCnt,false) then
begin
if icnt = 1 then
ip := ip1
else
ip := GetClosePoint(ap1,ip1,ip2);
if isPointinArc(ip,path.ArcCenter,radius,0,path.hr1,path.hr2,path.Inverted) then
if path.Dir = 1 then
begin
path.hr1 := ip;
end
else
begin
path.hr2 := ip;
end;
end;
end;
end;
function TNetCol.PathInter(p1, p2: TDoublePoint): Boolean;
var
ip,xp,xp1,xp2,xp3,xp4: TDoublePoint;
dist: Double;
i1,i2,i3,i4:Boolean;
begin
result := false;
GetPoints(xp1, xp2, xp3, xp4);
i1 := GetIntersectionPoint(p1,p2,xp1,xp2,ip,false,false);
i2 := GetIntersectionPoint(p1,p2,xp2,xp3,ip,false,false);
i3 := GetIntersectionPoint(p1,p2,xp3,xp4,ip,false,false);
i4 := GetIntersectionPoint(p1,p2,xp4,xp1,ip,false,false);
result := i1 or i2 or i3 or i4;
end;
procedure TNetCol.SetPosition;
var
path: TnetPath;
xPaths: TList;
xp1,xp2,xp3: TDoublePoint;
a1,a2,a3: Double;
Function isAngles2(ang1,ang2:Double): Boolean;
begin
result := ((ang1 = a1) and (ang2 = a2)) or ((ang1 = a2) and (ang2 = a1))
end;
Function isAngles3(ang1,ang2,ang3:Double): Boolean;
begin
result := false;
if (ang1 <> ang2) and (ang2 <> ang3) and (ang1 <> ang3) then
begin
result := ((ang1 = a1) or (ang1 = a2) or (ang1 = a3)) and
((ang2 = a1) or (ang2 = a2) or (ang2 = a3)) and
((ang3 = a1) or (ang3 = a2) or (ang3 = a3));
end;
end;
begin
xPaths := TList.Create;
Net.GetPathsOfKnot(p1,xPaths);
if (xPaths.Count < 2) or (xPaths.Count > 3) then
begin
Position := 0;
end
else
if xPaths.Count = 2 then
begin
path := TnetPath(xPaths[0]);
xp1 := path.OtherPoint(p1)^;
path := TnetPath(xPaths[1]);
xp2 := path.OtherPoint(p1)^;
a1 := GetRadOfLine(p1^,xp1);
a2 := GetRadOfLine(p1^,xp2);
if isAngles2(0,pi/2) then
Position := 1
else
if isAngles2(pi,pi/2) then
Position := 3
else
if isAngles2(3*(pi/2),0) then
Position := 7
else
if isAngles2(3*(pi/2),pi) then
Position := 5;
end
else
if xPaths.Count = 3 then
begin
path := TnetPath(xPaths[0]);
xp1 := path.OtherPoint(p1)^;
path := TnetPath(xPaths[1]);
xp2 := path.OtherPoint(p1)^;
path := TnetPath(xPaths[2]);
xp3 := path.OtherPoint(p1)^;
a1 := GetRadOfLine(p1^,xp1);
a2 := GetRadOfLine(p1^,xp2);
a3 := GetRadOfLine(p1^,xp3);
if isAngles3(0,pi,pi/2) then
Position := 2
else
if isAngles3(0,pi,3*(pi/2)) then
Position := 6
else
if isAngles3(0,pi/2,3*(pi/2)) then
Position := 8
else
if isAngles3(pi,pi/2,3*(pi/2)) then
Position := 4;
end;
xPaths.free;
end;
function TNetCol.SnapPoints(var x, y: Double; DotsPerMil: Double): Boolean;
var
d1,d2,d3,d4,d: Double;
p,pd:TDoublePoint;
tIdx: TPCTool;
fig: string;
snapDist: Double;
ap1,ap2,ap3,ap4: TDoublePoint;
begin
result := false;
snapDist := 24 / dotspermil;
p := DoublePoint(x, y);
tIdx := TPcDrawing(net.Owner).ToolIdx;
fig := TPcDrawing(net.Owner).SnapInfo;
if (fig = 'TPipeLine') or (Fig = 'TPipe') then
begin
GetPipePoints(ap1,ap2,ap3,ap4);
d1 := GetLineLenght(ap1,p);
d2 := GetLineLenght(ap2,p);
d3 := GetLineLenght(ap3,p);
d4 := GetLineLenght(ap4,p);
d := d1;pd := ap1;
if d2 < d then
begin
d := d2;pd := ap2;
end;
if d3 < d then
begin
d := d3;pd := ap3;
end;
if d4 < d then
begin
d := d4;pd := ap4;
end;
if (d < snapDist) then
begin
x := pd.x;
y := pd.y;
result := true;
end;
end;
end;
procedure TNetCol.WriteToStream(Stream: TStream);
var
colVersion:Byte;
i: Integer;
classIndex : Byte;
begin
classIndex := 1;
Stream.Write(classIndex,1);
colversion := 1;
Stream.Write(colversion,1);
i := net.Points.IndexOf(p1);
Stream.Write(i,4);
Stream.Write(w,8);
Stream.Write(h,8);
Stream.Write(Angle,8);
Stream.Write(Position,1);
end;
procedure TNetCol._Draw(Dengine: TPCdrawEngine; xColor: TColor;Fill:Boolean);
var
s: Integer;
ap1,ap2,ap3,ap4: TDoublePoint;
begin
if GetPoints(ap1,ap2,ap3,ap4) then
begin
if (net.DetDraw = false) and (Region <> 0) then
DeleteObject(Region);
fill := false;
if fill then
s := ord(bsSolid)
else
s := ord(bsClear);
if (net.DetDraw = false) then
Region := 0;
Dengine.drawrect(ap1,ap2,ap3,ap4,xColor,1,ord(psSolid),clWhite,s,HRGN(Region));
end;
end;
{ TInsertCol }
constructor TInsertCol.create(p1: TDoublepoint; xNet: Tnet);
begin
inherited create(0, dsTrace, nil);
Initialize; // tolik 29/07/2021 --
pointcount := 1;
actualpoints[1] := Doublepoint(p1.x,p1.y);
Net := xNet;
end;
class function TInsertCol.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
begin
Result := nil;
if assigned(TInsertCol(Shadow).Net) then
begin
TInsertCol(Shadow).Net.AddNetCol(Shadow.ap1);
end;
end;
class function TInsertCol.CreateShadow(x, y: Double): TFigure;
begin
result := nil;
CreateShadow := nil;
if not assigned(activenet) then
exit;
CreateShadow := TInsertCol.create(Doublepoint(x,y),ActiveNet);
end;
function TInsertCol.ShadowClick(ClickIndex: Integer; x,
y: Double): Boolean;
begin
result := True;
end;
function TInsertCol.ShadowTrace(ClickIndex: Integer; x,
y: Double): Boolean;
begin
end;
{ TNetRow }
constructor TNetRow.Create(xNet: Tnet; xp1, xp2: PDoublePoint);
begin
inherited Create(xNet);
Points.Add(xp1);
Points.Add(xp2);
Thick := 6;
Height := 6;
GetPipePoints(a1,a2,b1,b2);
end;
class function TNetRow.CreateFromStream(Stream: Tstream;
xNet: Tnet): TNetStruct;
var
rowVersion: Byte;
i: Integer;
xRow: TNetRow;
begin
result := nil;
xRow := TNetRow.Create(xNet, nil, nil);
Stream.Read(rowversion, 1);
// rowversion = 2;
Stream.Read(i, 4);
if (i > -1) and (i<xNet.Points.Count) then
begin
xRow.p1 := xNet.Points[i];
xRow.Points.Add(xRow.p1);
end;
Stream.Read(i, 4);
if (i > -1) and (i<xNet.Points.Count) then
begin
xRow.p2 := xNet.Points[i];
xRow.Points.Add(xRow.p2);
end;
if (not assigned(xRow.p1)) or (not assigned(xRow.p2)) then
begin
xRow.Free;
result := nil;
exit;
end;
Stream.Read(xRow.Thick, 8);
if rowversion > 1 then
begin
Stream.Read(xRow.Height, 8);
end;
Result := xRow;
end;
procedure TNetRow.Draw(Dengine: TPCdrawEngine; isGrayed: Boolean);
var
color: Integer;
begin
if isGrayed then
Color := clSilver
else
Color := clRed;
_Draw(Dengine,Color);
end;
procedure TNetRow.DrawGuides(DEngine: TPCDrawEngine);
begin
GetPipePoints;
Dengine.DrawPoint(a1,clSilver);
Dengine.DrawPoint(a2,clSilver);
Dengine.DrawPoint(b1,clSilver);
Dengine.DrawPoint(b2,clSilver);
end;
procedure TNetRow.DrawTrace(Dengine: TPCDrawEngine);
begin
_Draw(Dengine,clLime);
end;
function TNetRow.DuplicateNonPoints: TNetStruct;
begin
result := nil;
result := TNetRow.Create(Net,nil,nil);
result.Points.Clear;
TNetRow(Result).Thick := Thick;
end;
function TNetRow.GetPipePoints(var aa1, aa2, bb1, bb2: TDoublePoint): Boolean;
var
xp1,xp2,xp3,xp4: TDoublePoint;
begin
result := true;
GetPoints(xp1,xp2,xp3,xp4);
aa1 := MPoint(xp1,xp2,(Net.WallThick/2) + 1.0);
aa2 := MPoint(xp2,xp1,(Net.WallThick/2) + 1.0);
bb1 := MPoint(xp4,xp3,(Net.WallThick/2) + 1.0);
bb2 := MPoint(xp3,xp4,(Net.WallThick/2) + 1.0);
ExtendLine(aa1,bb1,1.0);
ExtendLine(aa2,bb2,1.0);
end;
procedure TNetRow.GetBounds(var figMaxX, figMaxY, figMinX,
figMinY: Double);
var
xp1,xp2,xp3,xp4: TDoublePoint;
begin
GetPoints(xp1,xp2,xp3,xp4);
figMaxX := xp1.x;
figMaxY := xp1.y;
figMinX := xp1.x;
figMinY := xp1.y;
if xp2.x > figMaxX then
figMaxX := xp2.x;
if xp3.x > figMaxX then
figMaxX := xp3.x;
if xp4.x > figMaxX then
figMaxX := xp4.x;
if xp2.x < figMinX then
figMinX := xp2.x;
if xp3.x < figMinX then
figMinX := xp3.x;
if xp4.x < figMinX then
figMinX := xp4.x;
if xp2.y > figMaxY then
figMaxY := xp2.y;
if xp3.y > figMaxY then
figMaxY := xp3.y;
if xp4.y > figMaxY then
figMaxY := xp4.y;
if xp2.y < figMinY then
figMinY := xp2.y;
if xp3.y < figMinY then
figMinY := xp3.y;
if xp4.y < figMinY then
figMinY := xp4.y;
end;
function TNetRow.GetPipePoints: Boolean;
begin
result := false;
result := GetPipePoints(a1,a2,b1,b2);
end;
function TNetRow.GetPoints(var ap1, ap2, ap3, ap4: TDoublePoint): Boolean;
var
ww: Double;
begin
result := false;
if (not assigned(p1)) and (Points.Count > 0) then
p1 := PDoublePoint(Points[0]);
if (not assigned(p2)) and (Points.Count > 1) then
p2 := PDoublePoint(Points[1]);
if (not assigned(p1)) and (not assigned(p2)) then
exit;
ww := thick/2;
GetParallelPoints(p1^,p2^,ap1,ap2,-ww);
GetParallelPoints(p1^,p2^,ap4,ap3,ww);
result := True;
end;
procedure TNetRow.IntersectPathPipe(Path: TnetPath);
var
ap1,ap2, ap3, ap4,ip,xp,ip1,ip2: TDoublePoint;
radius: Double;
iCnt: Integer;
begin
GetPipePoints(ap1,ap2,ap3,ap4);
if GetIntersectionPoint(path.hl1,path.hl2,ap1,ap2,ip,false,true) then
begin
if path.dir = 1 then
path.hl1 := ip
else
path.hl2 := ip;
end;
if GetIntersectionPoint(path.hl1,path.hl2,ap2,ap3,ip,false,true) then
begin
if path.dir = 1 then
path.hl1 := ip
else
path.hl2 := ip;
end;
if GetIntersectionPoint(path.hl1,path.hl2,ap3,ap4,ip,false,true) then
begin
if path.dir = 1 then
path.hl1 := ip
else
path.hl2 := ip;
end;
if GetIntersectionPoint(path.hl1,path.hl2,ap4,ap1,ip,false,true) then
begin
if path.dir = 1 then
path.hl1 := ip
else
path.hl2 := ip;
end;
if GetIntersectionPoint(path.hr1,path.hr2,ap1,ap2,ip,false,true) then
begin
if path.dir = 1 then
path.hr1 := ip
else
path.hr2 := ip;
end;
if GetIntersectionPoint(path.hr1,path.hr2,ap2,ap3,ip,false,true) then
begin
if path.dir = 1 then
path.hr1 := ip
else
path.hr2 := ip;
end;
if GetIntersectionPoint(path.hr1,path.hr2,ap3,ap4,ip,false,true) then
begin
if path.dir = 1 then
path.hr1 := ip
else
path.hr2 := ip;
end;
if GetIntersectionPoint(path.hr1,path.hr2,ap4,ap1,ip,false,true) then
begin
if path.dir = 1 then
path.hr1 := ip
else
path.hr2 := ip;
end;
end;
function TNetRow.IsPointIn(x, y: Double): Boolean;
begin
result := false;
result := inherited isPointIn(x,y);
end;
function TNetRow.SnapPoints(var x, y: Double; DotsPerMil: Double): Boolean;
var
d1,d2,d3,d4,d: Double;
p,pd:TDoublePoint;
tIdx: TPCTool;
fig: string;
snapDist: Double;
begin
result := false;
snapDist := 24 / dotspermil;
p := DoublePoint(x,y);
tIdx := TPcDrawing(net.Owner).ToolIdx;
fig := TPcDrawing(net.Owner).ToolInfo;
if (fig = 'TPipeLine') or (Fig = 'TPipe') then
begin
d1 := GetLineLenght(a1,p);
d2 := GetLineLenght(a2,p);
d3 := GetLineLenght(b1,p);
d4 := GetLineLenght(b2,p);
d := d1;
pd := a1;
if d2 < d then
begin
d := d2;pd := a2;
end;
if d3 < d then
begin
d := d3;
pd := b1;
end;
if d4 < d then
begin
d := d4;
pd := b2;
end;
if (d < snapDist) and (d<>0) then
begin
x := pd.x;
y := pd.y;
result := true;
end;
end;
end;
procedure TNetRow.WriteToStream(Stream: TStream);
var
rowVersion, classIndex: Byte;
i: Integer;
begin
classIndex := 2;
Stream.Write(classIndex,1);
rowVersion := 2;
Stream.Write(rowVersion,1);
i := net.Points.IndexOf(p1);
Stream.Write(i, 4);
i := net.Points.IndexOf(p2);
Stream.Write(i, 4);
Stream.Write(Thick, 8);
Stream.Write(Height, 8);
end;
procedure TNetRow._Draw(Dengine: TPCdrawEngine; xColor: TColor);
var
ap1,ap2,ap3,ap4,cp:TDoublePoint;
rad: Double;
begin
if GetPoints(ap1,ap2,ap3,ap4) then
begin
if (net.DetDraw = false) and (Region <> 0) then
DeleteObject(Region);
if (net.DetDraw = false) then
Region := 0;
Dengine.drawrect(ap1,ap2,ap3,ap4,xColor,1,ord(psDashDot),0,ord(bsClear),HRGN(Region));
cp := MPoint(ap1,ap3);
rad := GetRadOfLine(ap1,ap2);
DEngine.DrawCenteredText(cp, xColor, 'TNetRow._Draw', 'Tahoma', 3.0, rad);
end;
end;
function TNetRow.GetDistToPoint(p: TDoublePoint): Double;
var
xp,xp1,xp2,xp3,xp4: TDoublePoint;
dist: Double;
begin
result := 0;
GetPoints(xp1,xp2,xp3,xp4);
xp := p;
PointToLine(xp1,xp2,xp.x,xp.y);
dist := GetLineLength(xp,p);
result := dist;
xp := p;
PointToLine(xp3,xp4,xp.x,xp.y);
dist := GetLineLength(xp,p);
if dist < result then
result := dist;
end;
function TNetRow.PathInter(p1, p2: TDoublePoint): Boolean;
var
k1, k2: Double;
ip, xp, xp1, xp2, xp3, xp4: TDoublePoint;
i1, i2: Boolean;
begin
result := false;
GetPoints(xp1,xp2,xp3,xp4);
result := False;
k1 := Net.TopZ;
k2 := Net.TopZ - Height;
if (p1.z < k2) or (p2.z < k2) then
exit;
i1 := GetIntersectionPoint(p1,p2,xp1,xp2,ip,false,false);
i2 := GetIntersectionPoint(p1,p2,xp3,xp4,ip,false,false);
result := i1 or i2;
end;
procedure TNetRow.IntersectPath(Path: TnetPath);
begin
end;
{ TInsertRow }
constructor TInsertRow.create(p1: TDoublepoint; xNet: Tnet);
begin
inherited create(0, dsTrace, nil);
Initialize; // tolik 29/07/2021 --
pointcount := 2;
SnapPoint(p1.x, p1.y);
actualpoints[1] := Doublepoint(p1.x, p1.y);
actualpoints[2] := Doublepoint(p1.x, p1.y);
Net := xNet;
Valid := False;
end;
class function TInsertRow.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
begin
Result := nil;
if assigned(TInsertRow(Shadow).Net) and (TInsertRow(Shadow).Valid) then
begin
TInsertRow(Shadow).Net.AddNetRow(Shadow.ap1,shadow.ap2);
end;
end;
class function TInsertRow.CreateShadow(x, y: Double): TFigure;
begin
result := nil;
if not assigned(ActiveNet) then
exit;
if ActiveNet.IsPOintOnWall(DoublePoint(x,y)) then
Result := TInsertRow.create(DoublePoint(x,y), ActiveNet)
else
result := nil;
end;
procedure TInsertRow.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
begin
DEngine.Canvas.pen.mode := pmXor;
DEngine.drawline(ap1.x,ap1.y,ap2.x,ap2.y,clLime,1,1,0);
end;
function TInsertRow.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean;
begin
Result := False;
if ClickIndex = 2 then
begin
SnapPoint(x, y);
if Net.IsPOintOnWall(DoublePoint(x,y)) then
begin
ActualPoints[2] := DoublePoint(x,y);
Valid := True;
result := true;
end;
end;
end;
function TInsertRow.ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean;
begin
result := false;
SnapPoint(x,y);
ActualPoints[2] := DoublePoint(x,y);
end;
procedure TInsertRow.SnapPoint(var x, y: Double);
var
dx,dy: Double;
p1,p2: TDoublePoint;
wt: Double;
l,d,minD,dist: Double;
path:TnetPath;
begin
if not assigned(net) then
exit;
if not TPowercad(Net.Owner).SnapToNearPoint then
exit;
if Net.SnapToKnots(x,y,4,False) then
exit;
p1 := actualpoints[1];
dx := abs(x - p1.x);
dy := abs(y - p1.y);
if (dx > dy) and (dy < 20) then
dy := 0
else
if (dy > dx) and (dx < 20) then
dx := 0;
if x > p1.x then
x := p1.x + dx
else
x := p1.x - dx;
if y > p1.y then
y := p1.y + dy
else
y := p1.y - dy;
end;
{ TDoorTrace }
constructor TDoorTrace.Create(xNet: TNet; xPath: TNetPath; xDoor: TNetDoor);
var
ShowPathLengthType: TShowPathLengthType;
DirectionKoeff: Integer;
TmpPt: TDoublePoint;
DistToLine: Double;
procedure DefPointsByLenType(ap1, ap2: PDoublePoint);
var
DoorP1: TDoublePoint;
DrawDoorP1: TDoublePoint;
DrawNStart: Double;
begin
path.DefineInOutPoints;
PathP1 := ap1^;
PathP2 := ap2^;
//DirectionKoeff := GetParallelPointDirectionKoeff(path.p1^, path.p2^, PathP1);
//TmpPt := PathP1;
//PointToLineByAngle(path.p1^, path.p2^, TmpPt);
//DistToLine := GetDistToLine(path.p1^, path.p2^, PathP1);
//DistToLine := GetLineLenght(TmpPt, PathP1);
//GetParallelPoints(path.p1^, path.p2^, PathP1, PathP2, -1*DirectionKoeff * DistToLine);
//DrawStartOffset := GetLineLenght(path.p1^, PathP1) * (-1);
// Îïðåäåëÿåì íà ñêîëüêî ñìåùåíà ïåðâàÿ òî÷êà äâåðè
DoorP1 := MPoint(path.p1^, path.p2^, NStart);
DrawDoorP1 := MPoint(PathP1, PathP2, NStart);
// ïðîåöèðåì íà îñíîâíóþ ëèíèþ
PointToLineByAngle(path.p1^, path.p2^, DrawDoorP1);
DrawNStart := GetLineLenght(path.p1^, DrawDoorP1);
DrawStartOffset := NStart - DrawNStart;
end;
begin
inherited Create(0, dsTrace, nil);
Initialize; // tolik 29/07/2021 --
PointCount := 2;
Net := xNet;
Path := xPath;
Opath := xPath;
Door := xDoor;
Start := Door.Start;
//11.10.2010
//Opoint := MPoint(Door.p1, Door.p2);
//ActualPoints[1] := Opoint;
//ActualPoints[2] := Opoint;
p1 := Door.p1;
p2 := Door.p2;
NLen := Door.Len;
NStart := Start;
DefineActualPoints;
//19.04.2011
PathP1 := path.p1^;
PathP2 := path.p2^;
//22.05.2012 - Åñëè ñìåùåíèå ñòîðîíû ñåãìåíòà ïî ïåðïåíäèêóëÿðíîé òî÷êå
if Path.FPerpendDX <> 0 then
begin
PathP1.x := PathP1.x + Path.FPerpendDX;
PathP2.x := PathP2.x + Path.FPerpendDX;
end;
if Path.FPerpendDY <> 0 then
begin
PathP1.y := PathP1.y + Path.FPerpendDY;
PathP2.y := PathP2.y + Path.FPerpendDY;
end;
DrawStartOffset := 0;
ShowPathLengthType := sltPoints;
if Assigned(path.FOnGetShowPathTraceLengthType) then
ShowPathLengthType := path.FOnGetShowPathTraceLengthType(path);
case ShowPathLengthType of
sltInner:
begin
//path.DefineInOutPoints;
//PathP1 := path.ip1^;
//PointToLineByAngle(path.p1^, path.p2^, PathP1); //22.05.2012 PointToLine(path.p1^, path.p2^, PathP1.x, PathP1.y);
//PathP2 := path.ip2^;
//PointToLineByAngle(path.p1^, path.p2^, PathP2); //22.05.2012 PointToLine(path.p1^, path.p2^, PathP2.x, PathP2.y);
//DrawStartOffset := GetLineLenght(path.p1^, PathP1);
{path.DefineInOutPoints;
PathP1 := path.ip1^;
PathP2 := path.ip2^;
DirectionKoeff := GetParallelPointDirectionKoeff(path.p1^, path.p2^, PathP1);
TmpPt := PathP1;
PointToLineByAngle(path.p1^, path.p2^, TmpPt);
DistToLine := GetDistToLine(path.p1^, path.p2^, PathP1);
DistToLine := GetLineLenght(TmpPt, PathP1);
//GetParallelPoints(path.p1^, path.p2^, PathP1, PathP2, -1*DirectionKoeff * DistToLine);
//DrawStartOffset := GetLineLenght(path.p1^, PathP1) * (-1);}
path.DefineInOutPoints;
DefPointsByLenType(path.ip1, path.ip2);
end;
sltOuter:
begin
//path.DefineInOutPoints;
//PathP1 := path.op1^;
//PointToLineByAngle(path.p1^, path.p2^, PathP1); //22.05.2012 PointToLine(path.p1^, path.p2^, PathP1.x, PathP1.y);
//PathP2 := path.op2^;
//PointToLineByAngle(path.p1^, path.p2^, PathP2); //22.05.2012 PointToLine(path.p1^, path.p2^, PathP2.x, PathP2.y);
//DrawStartOffset := GetLineLenght(path.p1^, PathP1) * (-1);
{PathP1 := path.op1^;
PathP2 := path.op2^;
DirectionKoeff := GetParallelPointDirectionKoeff(path.p1^, path.p2^, PathP1);
TmpPt := PathP1;
PointToLineByAngle(path.p1^, path.p2^, TmpPt);
DistToLine := GetDistToLine(path.p1^, path.p2^, PathP1);
DistToLine := GetLineLenght(TmpPt, PathP1);
//GetParallelPoints(path.p1^, path.p2^, PathP1, PathP2, -1*DirectionKoeff * DistToLine);
//DrawStartOffset := GetLineLenght(path.p1^, PathP1); }
path.DefineInOutPoints;
DefPointsByLenType(path.op1, path.op2);
end;
end;
FIsShowLen := false; //11.10.2010
end;
procedure TDoorTrace.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
l1: Double;
l2: Double;
lText: String;
p1, p2, dp1, dp2, xp1, xp2, xp3, xp4: TDoublePoint;
uText: String;
aLength: string;
aText: string;
NewLen: Double; //11.10.2010
LenTopDraw: Boolean; //11.10.2010
LenDelta: Integer; //11.10.2010 íà ñêîëüêî öåíòðèðîâàòü òåêñò
PathRotated: Boolean;
begin
Dengine.Canvas.Pen.Mode := pmXor;
dp1 := MPoint(PathP1, PathP2, NStart + DrawStartOffset);
dp2 := MPoint(dp1, PathP2, NLen); //11.10.2010 dp2 := MPoint(dp1, path.p2^, Door.Len);
GetParallelPoints(dp1, dp2, xp1, xp2,((path.Width / 2) + 2));
GetParallelPoints(dp1, dp2, xp3, xp4,-((path.Width / 2) + 2));
// ëèíèè îò òî÷êè äâåðè ê òî÷êè TNetPath
Dengine.drawline(PathP1, dp1, clLime, 1, ord(psSolid), 0);
Dengine.drawline(dp2, PathP2, clLime, 1, ord(psSolid), 0);
Dengine.drawline(xp1, xp3, clLime, 1, ord(psSolid), 0);
Dengine.drawline(xp2, xp4, clLime, 1, ord(psSolid), 0);
l1 := GetLineLenght(PathP1, dp1){ - path.Width / 2};
l2 := GetLineLenght(PathP2, dp2){ - path.Width / 2};
NewLen := NLen;
if Net.WorldDim then
begin
l1 := l1 / 1000 * Net.MapScale;
l2 := l2 / 1000 * Net.MapScale;
NewLen := NewLen / 1000 * Net.MapScale;
end
else
begin
l1 := l1 / 10;
l2 := l2 / 10;
NewLen := NewLen / 10;
end;
p1 := MPoint(PathP1, dp1);
p2 := MPoint(PathP2, dp2);
aLength := FormatFloat(ffMask, MetreToUOM(L1));
if Net.WorldDim then
aText := GetUOMString(GCurrProjUnitOfMeasure)
else
aText := cCadClasses_Mes6;
Dengine.TraceText(p1, clLime, aLength + aText, 'Arial', 8);
aLength := FormatFloat(ffMask, MetreToUOM(L2));
if Net.WorldDim then
aText := GetUOMString(GCurrProjUnitOfMeasure)
else
aText := cCadClasses_Mes6;
Dengine.TraceText(p2, clLime, aLength + aText, 'Arial', 8);
//11.10.2010
if FIsShowLen then
begin
// òî÷êà ïîñðåäèíå îòñòóïíîé (ïàðàëåëüíîé) ëèíèè
//dp1 := MPoint(xp1, xp2);
//dp1 := MPoint(xp1, xp2, (NLen/3));
//if Path.PosType = ptVertical then
// dp1 := MPoint(xp3, xp4, (NLen/3));
LenTopDraw := true;
LenDelta := 3;
PathRotated := false;
if Path.PosType = ptVertical then
begin
LenTopDraw := false;
if PathP1.y > PathP2.y then
begin
LenTopDraw := true;
PathRotated := true;
end;
LenDelta := 2;
end
else
if Path.PosType = ptHorizontal then
begin
if PathP1.x > PathP2.x then
begin
LenTopDraw := false;
LenDelta := 3;
PathRotated := true;
end;
end;
if LenTopDraw then
begin
if Not PathRotated then
dp1 := MPoint(xp1, xp2, (NLen/LenDelta))
else
dp1 := MPoint(xp2, xp1, (NLen/LenDelta))
end
else
begin
if Not PathRotated then
dp1 := MPoint(xp3, xp4, (NLen/LenDelta))
else
dp1 := MPoint(xp4, xp3, (NLen/LenDelta))
end;
aLength := FormatFloat(ffMask, MetreToUOM(NewLen));
Dengine.TraceText(dp1, clLime, aLength + aText, 'Arial', 8);
end;
end;
procedure TDoorTrace.DefineActualPoints;
begin
Opoint := MPoint(p1, p2);
ActualPoints[1] := Opoint;
ActualPoints[2] := Opoint;
end;
procedure TDoorTrace.MovePoint(APoint: TDoublePoint; x, y: Double);
var
//dp1, dp2: TDoublePoint;
dx, dy: Double;
delta: Double;
begin
//dp1 := MPoint(path.p1^, path.p2^, NStart);
//dp2 := MPoint(dp1, path.p2^, Len);
delta := 0;
dx := x - APoint.x;
dy := y - APoint.y;
if Path.PosType = ptVertical then
begin
delta := dy;
if path.p1^.y > path.p2^.y then
delta := -delta;
end
else
if Path.PosType = ptHorizontal then
begin
delta := dx;
if path.p1^.x > path.p2^.x then
delta := -delta;
end;
if EQDP(APoint, p1) then
begin
if ((Door.Len - delta) > 0) and ((Start + delta)>0) then
begin
NStart := Start + delta;
NLen := Door.Len - delta;
end;
//p1 := APoint; //dp1;
//DefineActualPoints;
end
else if EQDP(APoint, p2) then
begin
if (Door.Len + delta) > 0 then
NLen := Door.Len + delta;
//p2 := APoint; //dp2;
//DefineActualPoints;
end
else
begin
//NLen := NLen;
end;
end;
procedure TDoorTrace.EndTrace;
var
ChangedLen: Boolean;
begin
if (Path <> oPath) then
begin
if Door.DoChangePathQuery(oPath, Path) then
begin
Path.Doors.Add(Door);
oPath.Doors.Remove(Door);
oPath.DoorIndex := -1;
//27.07.2011 Net.SelType := stPath;
//27.07.2011 Net.SelIndex := Net.Paths.IndexOf(Path) + 1;
Net.SelectPath(Net.Paths.IndexOf(Path) + 1);
end;
end;
ChangedLen := Abs(Door.Len - NLen) > 0.001;
Door.Start := NStart;
Door.Len := NLen;
Door.CalculatePoints(path.p1^, path.p2^);
Net.RefreshPaths;
Path.DoorIndex := Path.Doors.IndexOf(Door);
Door.DoResize;
if ChangedLen then
if Door.FComponID = 0 then
GArchEngine.SetLastDoorObjSize(Door.DoorObjType, Door.Len);
end;
procedure TDoorTrace.Locate(x, y: Double);
var
delta: Double;
dx, dy: Double;
xPath: TnetPath;
begin
xPath := nil;
delta := 0; //#From Oleg# //14.09.2010
ActualPoints[2] := DoublePoint(x, y);
if not Path.IsPointIn(x,y) then
xPath := Net.GetPathOfPoint(x, y);
if assigned(xPath) and (xPath <> Path) and (not xPath.isArc) and (xPath.WType = wtWall) then
begin
Path := xPath;
PointToLine(path.p1^, path.p2^, x, y);
OPoint := DoublePoint(x, y);
Start := GetLineLenght(path.p1^, Opoint) - (Door.Len / 2);
end;
ActualPoints[1] := DoublePoint(x, y);
dx := ap1.x - opoint.x;
dy := ap1.y - opoint.y;
if Path.PosType = ptVertical then
begin
delta := dy;
if path.p1^.y > path.p2^.y then
delta := -delta;
end
else
if Path.PosType = ptHorizontal then
begin
delta := dx;
if path.p1^.x > path.p2^.x then
delta := -delta;
end;
NStart := Start + delta;
if NStart < (Path.Width / 2) then
NStart := Path.Width / 2;
//11.10.2010 if NStart + Door.Len > (Path.AbsLen + Path.Width - (Path.Width / 2)) then
//11.10.2010 NStart := (Path.AbsLen + Path.Width - (Path.Width / 2)) - Door.Len;
if NStart + NLen > (Path.AbsLen + Path.Width - (Path.Width / 2)) then
NStart := (Path.AbsLen + Path.Width - (Path.Width / 2)) - NLen;
end;
procedure TDoorTrace.Move(dx, dy: Double);
begin
Locate(ap2.x + dx, ap2.y + dy);
end;
{ TPathTrace }
constructor TPathTrace.Create(xPath: TNetPath; xNet: TNet; Shift,Ctrl:Boolean);
begin
inherited Create(0,dsTrace,nil);
Initialize; // tolik 29/07/2021 --
Clone := nil;
FPathInClone := nil;
PointCount := 2;
Net := xNet;
Path := xPath;
FDrawP1 := xPath.p1^; //22.04.2011
FDrawP2 := xPath.p2^; //22.04.2011
Net.CollectBoundPoints(Path,NPoints1,NPoints2, Self);
Opoint := Mpoint(xPath.p1^,xPath.p2^);
p1 := xPath.p1^;
p2 := xPath.p2^;
op1 := p1;
op2 := p2;
xp1 := p1;
xp2 := p2;
ShiftP := shift;
CtrlP := ctrl;
repair := false;
// if (shiftP = True) and (ctrlP = True) then
relocate := false;
// else
// relocate := True;
if Relocate = True then
begin
if (ctrlP = true) or (shiftP = True) then deleteOld := False else deleteOld := true;
if (shiftP = true) or ((shiftP = false) and (ctrlP = false)) then repair := True;
end;
Actualpoints[1] := opoint;
ActualPoints[2] := opoint;
// Arc props
IsArc := xPath.IsArc;
ArcCenter := xPath.ArcCenter;
l1 := xPath.l1;
l2 := xPath.l2;
r1 := xPath.r1;
r2 := xPath.r2;
Inverted := xPath.Inverted;
FRelatedTraces := TList.Create;
FRelatedNets := TList.Create;
FIsRelated := false;
FRelatedOwner := nil;
end;
destructor TPathTrace.Destroy;
var
i: Integer;
begin
try
if FRelatedTraces <> nil then
begin
for i := 0 to FRelatedTraces.Count - 1 do
TObject(FRelatedTraces[i]).Free;
FreeAndNil(FRelatedTraces);
end;
if FRelatedNets <> nil then
begin
for i := 0 to FRelatedNets.Count - 1 do
TObject(FRelatedNets[i]).Free;
FreeAndNil(FRelatedNets);
end;
Net.FFigureModification := false;
Net.ClearRels;
if Assigned(Clone) then
FreeAndNil(Clone);
FPathInClone := nil;
except
on E: Exception do AddExceptionToLogEx('Destroy', E.Message);
end;
inherited;
end;
procedure TPathTrace.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
i: Integer;
len:Double;
Style: Integer;
ShowPathLengthType: TShowPathLengthType;
CanDraw: Boolean;
Procedure DrawLen(tp1,tp2: TDoublePoint);
var
uText,lText: String;
tp: TDoublePoint;
aLength: string;
aText: string;
begin
// uText := ' m';
// if len < 1 then begin
// len := len*100;
// uText := ' cm';
// end;
//if not snapped then
// len := Trunc(len*100)/100;
// lText := FloatToStr(len)+uText;
aLength := FormatFloat(ffMask, MetreToUOM(Len));
if Net.WorldDim then
aText := GetUOMString(GCurrProjUnitOfMeasure)
else
aText := cCadClasses_Mes6;
tp := MPoint(tp1, tp2);
if EQD(tp1.x, tp2.x) then
tp := MovePoint(tp, 3, 0)
else
tp := MovePoint(tp, 0, 3);
Dengine.TraceText(tp, clLime, aLength + aText, 'Arial', 8);
end;
// AFromPoint - òî÷êà íàõîäèòñÿ íà ñàìîé PathTrace
// op - òî÷êà ïîñðåäèíå (èñõîäíàÿ)
// ANPoints - êðàéíèå òî÷êè (îò èñõîäíîé â ïðîòèâîïîëîæíóþ ñòîðîíó)
procedure DrawNPoints(ANumPt: Integer; AFromPoint, ADrawFromPoint, op: TDoublePoint; var ANPoints: TDoublePointArr); //21.10.2010
var
i: Integer;
MiddleLineDrawed: Boolean;
LineDrawLater: Boolean;
CanDrawMiddleLine: Boolean;
WDelta: Double;
begin
MiddleLineDrawed := false;
if Not FIsRelated then
begin
//Dengine.drawline(AFromPoint, op,clLime,1,ord(psSolid),0);
len := (GetLineLenght(ADrawFromPoint, op)*Net.MapScale)/1000;
DrawLen(AFromPoint, op);
end;
CanDrawMiddleLine := true; //Not FIsRelated;
// Ëèíèÿ îò êðàéíåé òî÷êè äî íîâîé
for i := 0 to Length(ANPoints)-1 do
begin
if (not Relocate) or (EQD(ADrawFromPoint.x, ANPoints[i].x)) or (EQD(ADrawFromPoint.y, ANPoints[i].y)) then
begin
//LineDrawLater := false;
//if IsPointInLine(AFromPoint, op, ANPoints[i], 1) then
// LineDrawLater := true;
//if Not LineDrawLater then
Dengine.drawline(AFromPoint, ANPoints[i],clLime,1,ord(psSolid),0);
//15.04.2011 len := ((GetLineLenght(AFromPoint, ANPoints[i])-path.Width)*Net.MapScale)/1000;
len := GetLineLenght(ADrawFromPoint, ANPoints[i]);
if ShowPathLengthType <> sltPoints then
begin
WDelta := path.Width;
//case ANumPt of
// 1:
// WDelta := Abs(WidthOut1 - WidthInner1) / 4;
// 2:
// WDelta := Abs(WidthOut2 - WidthInner2) / 4;
//end;
//WDelta := path.Width / 2;
//case ShowPathLengthType of
// sltInner:
// len := len - WDelta;
// sltOuter:
// len := len + WDelta;
//end;
end;
len := (len * Net.MapScale)/1000;
DrawLen(AFromPoint, ANPoints[i]);
//if CanDrawMiddleLine and Not LineDrawLater then
// // Åñëè ñðåäíÿÿ ëèíèÿ (îò èñõîäíîé òî÷êè äî íîâîé) ïîïàäàåò â ïðîìåæóòêè òîëüêî ÷òî îòðèñîâàíîé
// if IsPointInLine(AFromPoint, ANPoints[i], op, 1) then
// CanDrawMiddleLine := false;
end;
end;
if CanDrawMiddleLine then
begin
// ëèíèÿ îò èñõîäíîé òî÷êè äî íîâîé
Dengine.drawline(AFromPoint, op,clLime,1,ord(psSolid),0);
end;
end;
begin
ShowPathLengthType := sltInner;
if Assigned(Path.FOnGetShowPathTraceLengthType) then
ShowPathLengthType := Path.FOnGetShowPathTraceLengthType(Path);
if Not Assigned(Clone) then
begin
if Not FIsRelated then
begin
Dengine.Canvas.Pen.Mode := pmXor;
Style := Ord(psSolid); //22.10.2010
if IsArc then
Style := Ord(psDot);
Dengine.drawline(p1,p2,clWhite xor clRed,1, Style,0);
//21.10.2010
//Dengine.drawline(p1,op1,clLime,1,ord(psSolid),0);
//len := (GetLineLenght(p1,op1)*Net.MapScale)/1000;
//DrawLen(p1,op1);
//Dengine.drawline(p2,op2,clLime,1,ord(psSolid),0);
//len := (GetLineLenght(p2,op2)*Net.MapScale)/1000;
//DrawLen(p2,op2);
//22.10.2010
if IsArc then
begin
//Dengine.Canvas.Pen.Mode := pmCopy;
DrawArc(DEngine, clLime, Ord(psSolid));
//Dengine.Canvas.Pen.Mode := pmXor;
end;
end;
//21.10.2010
//for i := 0 to Length(Npoints1)-1 do begin
// if (not Relocate) or (EQD(p1.x,Npoints1[i].x)) or (EQD(p1.y,Npoints1[i].y)) then
// begin
// Dengine.drawline(p1,Npoints1[i],clLime,1,ord(psSolid),0);
// len := ((GetLineLenght(p1,Npoints1[i])-path.Width)*Net.MapScale)/1000;
// DrawLen(p1,Npoints1[i]);
// end;
//end;
//for i := 0 to Length(Npoints2)-1 do begin
// if (not Relocate) or (EQD(p2.x,Npoints2[i].x)) or (EQD(p2.y,Npoints2[i].y)) then
// begin
// Dengine.drawline(p2,Npoints2[i],clLime,1,ord(psSolid),0);
// len := ((GetLineLenght(p2,Npoints2[i])-path.Width)*Net.MapScale)/1000;
// DrawLen(p2,Npoints2[i]);
// end;
//end;
DrawNPoints(1, p1, FDrawP1, op1, NDrawPoints1); //21.10.2010
DrawNPoints(2, p2, FDrawP2, op2, NDrawPoints2); //21.10.2010
end
else
Clone.draw(DEngine, isGrayed);
DrawRelated(DEngine, isGrayed);
end;
procedure TPathTrace.DrawArc(Dengine: TPCDrawEngine;Color:Tcolor; style:Integer);
var
rgn: HRGN;
rad1,rad2,ang1,ang2: Double;
px,py:TDoublePoint;
begin
rad1 := GetLineLenght(ArcCenter,l1);
if Inverted then
begin
ang1 := GetRadOfLine(ArcCenter,l1);
ang2 := GetRadOfLine(ArcCenter,l2);
end
else
begin
ang1 := GetRadOfLine(ArcCenter,l2);
ang2 := GetRadOfLine(ArcCenter,l1);
end;
if ang2 = 0 then
ang2 := 2 * pi;
Dengine.drawbezarc(ArcCenter.x,ArcCenter.y,rad1,ang1,ang2,color,1,style,0,0,0,rgn,px,py,true,0);
rad1 := GetLineLenght(ArcCenter,r1);
if Inverted then
begin
ang1 := GetRadOfLine(ArcCenter,r1);
ang2 := GetRadOfLine(ArcCenter,r2);
end
else
begin
ang1 := GetRadOfLine(ArcCenter,r2);
ang2 := GetRadOfLine(ArcCenter,r1);
end;
if ang2 = 0 then
ang2 := 2 * pi;
rgn := 1;
Dengine.drawbezarc(ArcCenter.x,ArcCenter.y,rad1,ang1,ang2,color,1,style,0,0,0,rgn,px,py,true,0);
// ëèíèè îò öåíòðàëüíîé òî÷êè äî òî÷åê ñåãìåíòà
//if isGrayed then
// Color := Grayedcolor;
//DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p1.x,p1.y, Color, 1, ord(psSolid), 0);
//DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p2.x,p2.y, Color, 1, ord(psSolid), 0);
// Ëèíèÿ ìåæäó òî÷êàìè
//DEngine.DrawLine(p1.x,p1.y, p2.x,p2.y, Color, 1, ord(psSolid), 0);
end;
Procedure TPathTrace.DrawRelated(DEngine:TPCDrawEngine;isGrayed:Boolean);
var
i: Integer;
begin
for i := 0 to FRelatedTraces.Count - 1 do
TPathTrace(FRelatedTraces[i]).Draw(DEngine, isGrayed);
for i := 0 to FRelatedNets.Count - 1 do
TNet(FRelatedNets[i]).Draw(DEngine, isGrayed);
end;
function TPathTrace.IsRelatedTo(Apt1, Apt2: PDoublePoint): Boolean;
function IsRelBySide(p: PDoublePoint; var APoints: TDoublePointArr): Boolean;
var
i: Integer;
begin
Result := false;
for i := 0 to Length(APoints) - 1 do
begin
if path.Net.CmpIntersectPaths(Apt1, Apt2, p, @APoints[i]) = citEqual then
begin
Result := true;
Break; //// BREAK ////
end;
end;
end;
begin
Result := IsRelBySide(@p1, NPoints1) or IsRelBySide(@p2, NPoints2);
end;
procedure TPathTrace.EndTrace;
var
dx, dy, delta: Double;
repair: Boolean;
NetList: TList;
i: Integer;
DefinedMoveObjs: Boolean;
begin
dx := p1.x - path.p1^.x;
dy := p1.y - path.p1^.y;
FEDeltaX := dx;
FEDeltaY := dy;
delta := dx;
if abs(dy) > abs(dx) then
delta := -dy;
// if (shiftP = True) and (ctrlP = True) then
relocate := false;
{
else
relocate := True;
if Relocate = True then
begin
if abs(delta) < 5 then
begin
Net.MovePath(Path, dx, dy);
end
else
begin
if (ctrlP = true) or (shiftP = True) then
deleteOld := False
else
deleteOld := true;
repair := false;
if (shiftP = true) or ((shiftP = false) and (ctrlP = false)) then
repair := True;
Net.LocateSelPath(delta, deleteOld, repair);
end;
end
else
}
{//22.09.2011
Net.MovePath(Path,dx,dy);
EndTraceRelated; //19.10.2010
//25.05.2011
if Not FIsRelated then
begin
if Assigned(Net.FOnDefineMoveObjects) and Net.CanMoveJoined then
begin
NetList := TList.Create;
NetList.Assign(Self.Net.FRelatedNets);
NetList.Insert(0, Self.Net);
if Net.FOnDefineMoveObjects(Net, nil, Path, NetList) then
begin
for i := 0 to NetList.Count - 1 do
TNet(NetList[i]).MoveJoinedPoints(dx, dy, false);
end;
NetList.Free;
end;
end;}
NetList := nil;
DefinedMoveObjs := false;
//25.05.2011
if Not FIsRelated then
begin
if Assigned(Net.FOnDefineMoveObjects) and Net.CanMoveJoined then
begin
NetList := TList.Create;
NetList.Assign(Self.Net.FRelatedNets);
NetList.Insert(0, Self.Net);
DefinedMoveObjs := Net.FOnDefineMoveObjects(Net, nil, Path, NetList);
end;
end;
Net.MovePath(Path,dx,dy);
EndTraceRelated; //19.10.2010
if NetList <> nil then
begin
if DefinedMoveObjs then
for i := 0 to NetList.Count - 1 do
TNet(NetList[i]).MoveJoinedPoints(dx, dy, false);
NetList.Free;
end;
end;
Procedure TPathTrace.EndTraceRelated;
var
i: Integer;
RelNets: TList;
RelNet: TNet;
RelPath: TNetPath;
RelTrace: TPathTrace;
CanSnap: Boolean;
//TempPt: TDoublePoint;
TempPt1, TempPt2: TDoublePoint;
Pt1InLine, Pt2InLine: Boolean;
MarginDelta: Double;
MovedToPath: TNetPath; // Ñåãìåíò ê êîòîðîìó ïðèìàãíè÷åí
begin
RelNets := nil;
MovedToPath := nil;
MarginDelta := 2; //0.7;
// Ñäâèãàì òåêóùèå ñìåæíûå ñòåíû (êîòîðûå áûëè ñìåæíûìè äî ïåðåòàñêèâàíèÿ)
for i := 0 to FRelatedTraces.Count - 1 do
begin
RelTrace := TPathTrace(FRelatedTraces[i]);
//if RelTrace.Path <> MovedToPath then
begin
// Òî÷êè ïîäòÿãèâàåì ê ëèíèè, ÷òîáû âñå áûëî êàê ìîæíî ðîâíåå
PointToLine(p1, p2, RelTrace.p1.x, RelTrace.p1.y);
PointToLine(p1, p2, RelTrace.p2.x, RelTrace.p2.y);
RelTrace.EndTrace;
end;
end;
//24.05.2011
for i := 0 to FRelatedNets.Count - 1 do
begin
RelNet := TNet(FRelatedNets[i]);
if (RelNet.FRelatedMPath <> nil) and (RelNet.FRelatedMPath is TNetPath) and
Assigned(RelNet.FSrcNet) and Assigned(RelNet.FSrcNet.FRelatedMPath) then
begin
//10.06.2011
if Not Assigned(RelNet.FRelatedMPath) or
(Not RelNet.CheckPtInJoinedMove(RelNet.FRelatedMPath.p1) and
Not RelNet.CheckPtInJoinedMove(RelNet.FRelatedMPath.p2)) then
RelNet.FSrcNet.MovePath(RelNet.FSrcNet.FRelatedMPath, FEDeltaX, FEDeltaY);
end;
end;
// Ñòàâèì ïîèíòû ñâÿçàííûõ Net
if (Net <> nil) and (Net.FRelatedNets.Count > 0) then
for i := 0 to Net.FRelatedNets.Count - 1 do
begin
RelNet := TNet(Net.FRelatedNets[i]);
if (RelNet.FRelatedMPoint <> nil) and (RelNet.FPathTracePoint <> nil) {and
((RelNet.FRelatedObject = nil) or (RelNet.FRelatedObject <> MovedToPath))} then
begin
if Not RelNet.CheckPtInJoinedMove(RelNet.FRelatedMPoint) then
RelNet.LocatePoint(RelNet.FRelatedMPoint, RelNet.FPathTracePoint^.x, RelNet.FPathTracePoint^.y);
end;
end;
if Not FIsRelated then
begin
// ïîäòÿãèâàåì ê íàéäåííîìó ñìåæíîìó
RelNets := Net.GetRelatedNetsByPoints(Path.p1, Path.p2, citEntry);
//RelNets := Net.GetRelatedNetsByPoints(Path.p1, Path.p2);
if RelNets <> nil then
begin
for i := 0 to RelNets.Count - 1 do
begin
RelNet := TNet(RelNets[i]);
if (RelNet.FRelatedObject <> nil) and
(RelNet.FRelatedObject is TNetPath) and Not TNetPath(RelNet.FRelatedObject).IsArc then
begin
RelPath := TNetPath(RelNet.FRelatedObject);
{//28.12.2010
if PointNear(RelPath.p1^, Path.p1^) and PointNear(RelPath.p2^, Path.p2^) then
begin
Path.p1.x := RelPath.p1.x;
Path.p1.y := RelPath.p1.y;
Path.p2.x := RelPath.p2.x;
Path.p2.y := RelPath.p2.y;
end
else
if PointNear(RelPath.p2^, Path.p1^) and PointNear(RelPath.p1^, Path.p2^) then
begin
Path.p1.x := RelPath.p2.x;
Path.p1.y := RelPath.p2.y;
Path.p2.x := RelPath.p1.x;
Path.p2.y := RelPath.p1.y;
end;}
if Not RelNet.CheckPtInJoinedMove(RelPath.p1) and
Not RelNet.CheckPtInJoinedMove(RelPath.p2) then
begin
if Path.CmpIntersectPath(RelPath, MarginDelta) in [citEqual, citEntry] then
begin
CanSnap := true;
if CanSnap then
begin
TempPt1 := Path.p1^;
PointToLine(RelPath.p1^, RelPath.p2^, TempPt1.x, TempPt1.y);
Pt1InLine := isPointinLine(RelPath.p1^, RelPath.p2^,TempPt1,1, MarginDelta);
TempPt2 := Path.p2^;
PointToLine(RelPath.p1^, RelPath.p2^, TempPt2.x, TempPt2.y);
Pt2InLine := isPointinLine(RelPath.p1^, RelPath.p2^,TempPt2,1, MarginDelta);
if Pt1InLine and Pt2InLine then
begin
Path.p1^ := TempPt1;
Path.p2^ := TempPt2;
MovedToPath := RelPath;
if Assigned(Net.FOnMergePaths) then
RelNet.FOnMergePaths(RelPath, Path);
Break; //// BREAK ////
end;
end;
end;
end;
end;
end;
RelNets.Free;
end;
end;
end;
procedure TPathTrace.Move(dx, dy: Double);
var
wt: Double;
l, d, minD, dist: Double;
lx, ly: Double;
i: integer;
Guide: TGuideLine;
GuideDistX, GuideDistY: Double;
Cad: TPowerCad;
OldPt1, OldPt2: TDoublePoint;
//DeltaX, DeltaY: Double;
begin
OldPt1 := p1;
OldPt2 := p2;
if assigned(Net.Owner) then
Cad := TPowerCad(Net.Owner)
else
Cad := nil;
if Path.PosType = ptVertical then
dy := 0
else
dx := 0;
xp1 := MovePoint(xp1, dx, dy);
xp2 := MovePoint(xp2, dx, dy);
if SnappedGrid then
begin
minD := Cad.GridStep;
wt := Net.WallThick;
lx := abs(xp1.x - op1.x);
ly := abs(xp1.y - op1.y);
// ïåðåìåùåíèå ïî âåðòèêàëè
if lx <> 0 then
begin
d := lx;
d := d + wt;
l := Trunc(d / minD) * mind;
dist := d - l;
if dist >= (mind / 2) then
begin
l := l + MinD;
end;
l := l - wt;
if xp1.x > op1.x then
p1.x := op1.x + l
else
p1.x := op1.x - l;
if xp2.x > op2.x then
p2.x := op2.x+l
else
p2.x := op2.x-l;
end;
// ïåðåìåùåíèå ïî ãîðèçîíòàëè
if (ly <> 0) then
begin
d := ly;
d := d + wt;
l := Trunc(d / minD) * mind;
dist := d - l;
if dist >= (mind / 2) then
begin
l := l + MinD;
end;
l := l - wt;
if xp1.y > op1.y then
p1.y := op1.y + l
else
p1.y := op1.y - l;
if xp2.y > op2.y then
p2.y := op2.y + l
else
p2.y := op2.y - l;
end;
end
else
if SnappedGuide then
begin
lx := abs(xp1.x - op1.x);
ly := abs(xp1.y - op1.y);
GuideDistX := 12 / Cad.DotsPerMil;
GuideDistY := 12 / Cad.DotsPerMil;
// ïðè ïåðåìåùåíèè ïî âåðòèêàëè
if lx <> 0 then
begin
for i := 0 to Cad.Guides.count - 1 do
begin
Guide := TGuideLine(Cad.Guides[i]);
if Guide.gType = gtVert then
begin
If abs(Guide.coord - xp1.x) < GuideDistX then
begin
GuideDistX := abs(Guide.coord - xp1.x);
if xp1.x > p1.x then
xp1.x := xp1.x + GuideDistX
else
xp1.x := xp1.x - GuideDistX;
if xp2.x > p2.x then
xp2.x := xp2.x + GuideDistX
else
xp2.x := xp2.x - GuideDistX;
end
else
If abs(Guide.coord - xp2.x) < GuideDistX then
begin
GuideDistX := abs(Guide.coord - xp2.x);
if xp1.x > p1.x then
xp1.x := xp1.x + GuideDistX
else
xp1.x := xp1.x - GuideDistX;
if xp2.x > p2.x then
xp2.x := xp2.x + GuideDistX
else
xp2.x := xp2.x - GuideDistX;
end;
end;
end;
end;
// ïðè ïåðåìåùåíèè ïî ãîðèçîíòàëè
if ly <> 0 then
begin
for i := 0 to Cad.Guides.count - 1 do
begin
Guide := TGuideLine(Cad.Guides[i]);
if Guide.gType = gtHorz then
begin
If abs(Guide.coord - xp1.y) < GuideDistY then
begin
GuideDistY := abs(Guide.coord - xp1.y);
if xp1.y > p1.y then
xp1.y := xp1.y + GuideDistY
else
xp1.y := xp1.y - GuideDistY;
if xp2.y > p2.y then
xp2.y := xp2.y + GuideDistY
else
xp2.y := xp2.y - GuideDistY;
end
else
If abs(Guide.coord - xp2.y) < GuideDistY then
begin
GuideDistY := abs(Guide.coord - xp2.y);
if xp1.y > p1.y then
xp1.y := xp1.y + GuideDistY
else
xp1.y := xp1.y - GuideDistY;
if xp2.y > p2.y then
xp2.y := xp2.y + GuideDistY
else
xp2.y := xp2.y - GuideDistY;
end;
end;
end;
end;
p1 := xp1;
p2 := xp2;
end
else
begin
p1 := xp1;
p2 := xp2;
end;
FDrawP1.x := FDrawP1.x + (p1.x-OldPt1.x);
FDrawP1.y := FDrawP1.y + (p1.y-OldPt1.y);
FDrawP2.x := FDrawP2.x + (p2.x-OldPt2.x);
FDrawP2.y := FDrawP2.y + (p2.y-OldPt2.y);
FMDeltaX := p1.x - OldPt1.x;
FMDeltaY := p1.y - OldPt1.y;
//22.10.2010
if isArc then
begin
ArcCenter.x := ArcCenter.x + FMDeltaX;
ArcCenter.y := ArcCenter.y + FMDeltaY;
l1.x := l1.x + FMDeltaX;
l1.y := l1.y + FMDeltaY;
l2.x := l2.x + FMDeltaX;
l2.y := l2.y + FMDeltaY;
r1.x := r1.x + FMDeltaX;
r1.y := r1.y + FMDeltaY;
r2.x := r2.x + FMDeltaX;
r2.y := r2.y + FMDeltaY;
end;
if (Clone <> nil) and (FPathInClone <> nil) then
begin
if FPathInCloneInversePt then
begin
FPathInClone.p1^ := p2;
FPathInClone.p2^ := p1;
end
else
begin
FPathInClone.p1^ := p1;
FPathInClone.p2^ := p2;
end;
if Net.CanMoveJoined then
Clone.MoveJoinedPoints(FMDeltaX, FMDeltaY, false);
// Îáíîâëÿåì òî÷êè äëÿ ðàñ÷åòà äëèí â çàâèñèìîñòè îò ðåæèìà
Clone.RefreshPaths;
//Clone.DefineInOutPoints;
//Clone.CollectBoundPoints(Path,NPoints1,NPoints2, Self);
end;
MoveRelated(dx, dy); //19.10.2010
end;
Procedure TPathTrace.MoveRelated(dx, dy: Double);
var
i: Integer;
RelNet: TNet;
begin
for i := 0 to FRelatedTraces.Count - 1 do
TPathTrace(FRelatedTraces[i]).Move(dx, dy);
for i := 0 to FRelatedNets.Count - 1 do
begin
RelNet := TNet(FRelatedNets[i]);
if (RelNet.FRelatedMPoint <> nil) and (RelNet.FPathTracePoint <> nil) then
if Not RelNet.CheckPtInJoinedMove(RelNet.FRelatedMPoint) then //10.06.2011
RelNet.FRelatedMPoint^ := RelNet.FPathTracePoint^;
if (RelNet.FRelatedMPath <> nil) and (RelNet.FRelatedMPath is TNetPath) then
begin
if Not RelNet.CheckPtInJoinedMove(RelNet.FRelatedMPath.p1) then //10.06.2011
begin
RelNet.FRelatedMPath.p1.x := RelNet.FRelatedMPath.p1.x + FMDeltaX;
RelNet.FRelatedMPath.p1.y := RelNet.FRelatedMPath.p1.y + FMDeltaY;
end;
if Not RelNet.CheckPtInJoinedMove(RelNet.FRelatedMPath.p2) then //10.06.2011
begin
RelNet.FRelatedMPath.p2.x := RelNet.FRelatedMPath.p2.x + FMDeltaX;
RelNet.FRelatedMPath.p2.y := RelNet.FRelatedMPath.p2.y + FMDeltaY;
end;
end;
if Net.CanMoveJoined then
RelNet.MoveJoinedPoints(FMDeltaX, FMDeltaY, false);
RelNet.RefreshPaths; //13.05.2011
end;
end;
{ TWallRect }
constructor TWallRect.create(p1: TDoublepoint; xNet: Tnet);
begin
inherited create(0, dsTrace, nil);
Initialize; // tolik 29/07/2021 --
pointcount := 2;
actualpoints[1] := Doublepoint(p1.x, p1.y);
actualpoints[2] := Doublepoint(p1.x, p1.y);
Net := xNet;
Valid := True;
RefPaths := TList.Create;
FStarted := False;
CIndex := 0;
end;
class function TWallRect.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var
points: TDoublePointArr;
i: Integer;
begin
result := nil;
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
if TWallRect(Shadow).valid and assigned(ActiveNet) then
begin
SetLength(Points, 5);
Points[0] := Shadow.ap1;
Points[1] := DoublePoint(Shadow.ap2.x, Shadow.ap1.Y);
Points[2] := Shadow.ap2;
Points[3] := DoublePoint(Shadow.ap1.x, Shadow.ap2.Y);
Points[4] := Shadow.ap1;
ActiveNet.MakePathOnShadow(points, false); //03.06.2013 ActiveNet.MakePath(points, false);
end;
// *UNDO*
// Tolik 07/05/2019 --
if not GProjectChanged then
SetProjectChanged(true);
GCadForm.FCanSaveForUndo := True;
end;
class function TWallRect.CreateShadow(x, y: Double): TFigure;
var
cad: TPowerCad;
Shift: TShiftState;
begin
result := nil;
if assigned(ActiveNet) then
CreateShadow := TWallRect.create(Doublepoint(x, y), ActiveNet)
else
CreateShadow := nil;
end;
destructor TWallRect.Destroy;
begin
RefPaths.Free;
inherited;
end;
procedure TWallRect.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
i: Integer;
mp, p1: TDoublePoint;
p2: TDoublePoint;
l: Double;
ltext, uText: String;
xp1, xp2, xp3, xp4: TDoublePoint;
xPath: TNetPath;
d1, d2: Double;
aLength: string;
aText: string;
begin
DEngine.Canvas.pen.mode := pmXor;
for i := 0 to RefPaths.Count - 1 do
begin
xPath := TNetPath(RefPaths[i]);
xP1 := ap1;
PointToLine(xPath.p1^, xPath.p2^, xp1.x, xp1.y);
if CIndex = 1 then
begin
xp2 := ap2;
PointToLine(xPath.p1^, xPath.p2^, xp2.x, xp2.y);
d1 := GetLineLength(xp1, ap1);
d2 := GetLineLength(xp2, ap2);
if d1 < d2 then
begin
p1 := xp1;
p2 := ap1;
end
else
begin
p1 := xp2;
p2 := ap2;
end;
end
else
begin
p1 := xp1;
p2 := ap1;
end;
Dengine.drawline(p1, p2, clLime, 1, ord(psSOlid), 0);
mp := MPoint(p1, p2);
l := GetLen(p1, p2);
if l > 0 then
begin
aLength := FormatFloat(ffMask, MetreToUOM(l));
if Net.WorldDim then
aText := GetUOMString(GCurrProjUnitOfMeasure)
else
aText := cCadClasses_Mes6;
Dengine.TraceText(mp, clLime, aLength + aText, 'Arial', 8);
end;
end;
p1 := ActualPoints[1];
p2 := ActualPoints[2];
Dengine.drawrect(p1, p2, clLime, 1, ord(psSolid), 0, ord(bsClear));
xp1 := ap1;
xp2 := DoublePoint(ap2.x, ap1.Y);
xp3 := ap2;
xp4 := DoublePoint(ap1.x, ap2.Y);
mp := MPoint(xp1, xp2);
l := GetLen(xp1, xp2);
if l > 0 then
begin
aLength := FormatFloat(ffMask, MetreToUOM(l));
if Net.WorldDim then
aText := GetUOMString(GCurrProjUnitOfMeasure)
else
aText := cCadClasses_Mes6;
if EQD(xp1.x, xp2.x) then
mp := MovePoint(mp, 2, 0)
else
mp := MovePoint(mp, 0, 2);
Dengine.TraceText(mp, clLime, aLength + aText, 'Arial', 8);
end;
mp := MPoint(xp2, xp3);
l := GetLen(xp2, xp3);
if l > 0 then
begin
aLength := FormatFloat(ffMask, MetreToUOM(l));
if Net.WorldDim then
aText := GetUOMString(GCurrProjUnitOfMeasure)
else
aText := cCadClasses_Mes6;
if EQD(xp2.x, xp3.x) then
mp := MovePoint(mp, 2, 0)
else
mp := MovePoint(mp, 0, 2);
Dengine.TraceText(mp, clLime, aLength + aText, 'Arial', 8);
end;
end;
function TWallRect.GetLen(p1, p2: TDoublePoint): Double;
var
wt: Double;
l: Double;
begin
result := 0;
l := GetLineLenght(p1, p2);
if l = 0 then
begin
result := 0;
exit;
end;
wt := net.WallThick;
Result := l{ - wt};
if Net.WorldDim then
Result := Result / 1000 * Net.MapScale
else
Result := Result / 10;
end;
procedure TWallRect.LockTrace;
var
dx, dy: Double;
begin
if CIndex = 1 then
begin
if xLocked or yLocked then
begin
UnLockTrace;
end
else
begin
dx := abs(ap1.x - ap2.x);
dy := abs(ap1.y - ap2.y);
if dx > dy then
begin
XLocked := True;
end
else
begin
YLocked := True;
end;
end;
end;
end;
function TWallRect.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean;
var
Cad: TPowercad;
xPath: TnetPath;
begin
Result := false;
Shift := [];
if assigned(Net.Owner) then
begin
Cad := Tpowercad(Net.Owner);
Shift := Cad.CurrentShift;
end;
if (not FStarted) and (not (ssShift in Shift)) then
FStarted := True;
if not FStarted then
begin
xPath := Net.GetPathOfPoint(x, y);
if assigned(xPath) then
RefPaths.Add(xPath);
end;
if FStarted then
CIndex := CIndex + 1;
if CIndex = 1 then
begin
SnapPoint(x, y);
if xLocked then
x := ap2.x;
if yLocked then
y := ap2.y;
actualPoints[1] := DoublePoint(x, y);
end
else
if CIndex = 2 then
begin
SnapPoint(x, y);
if xLocked then
x := ap2.x;
if yLocked then
y := ap2.y;
actualPoints[2] := DoublePoint(x, y);
Result := True;
end;
end;
function TWallRect.ShadowKeyStroke(var ClickIndex,KeyCode: Integer;
Shift: TShiftState;var Fnished:Boolean): Boolean;
var
res: String;
sArr: TStringArray;
a, b: Double;
begin
result := False;
if (ClickIndex = 1) and (keyCode = vk_F11) then
begin
res := inputBox('TWallRect.ShadowKeyStroke', '', '');
if res <> '' then
begin
res := stringreplace(res,'X', 'x', []);
SplitStr(res, sArr, 'x');
if Length(sArr) = 2 then
begin
a := StrToInt64Def(Trim(sArr[0]), -1);
b := StrToInt64Def(Trim(sArr[1]), -1);
a := a + 0.2;
b := b + 0.2;
if (a > 0) and (b > 0) then
begin
a := (a * 1000) / Net.MapScale;
b := (b * 1000) / Net.MapScale;
ActualPoints[2] := MovePoint(ap1, a, b);
result := True;
Fnished := true;
end;
end;
end;
end;
end;
function TWallRect.ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean;
var
ox: Double;
oy: Double;
begin
result := false;
SnapPoint(x, y);
if xLocked then
x := ap2.x;
if yLocked then
y := ap2.y;
if CIndex = 0 then
begin
actualpoints[1] := DoublePoint(x, y);
actualpoints[2] := DoublePoint(x, y);
end
else
if CIndex = 1 then
begin
actualpoints[2] := DoublePoint(x, y);
end;
end;
procedure TWallRect.SnapPoint(var x, y: Double);
var
wt: Double;
l, d, minD, dist: Double;
p1, p2: TDoublePOint;
begin
if not assigned(net) then
exit;
if not TPowercad(Net.Owner).SnapToNearPoint then
exit;
if Net.SnapToKnots(x, y, 4, False) then
exit;
p1 := actualpoints[1];
minD := 100 / Net.MapScale;
wt := net.WallThick;
d := abs(x - p1.x);
d := d + wt;
l := Trunc(d / minD) * mind;
dist := d - l;
if dist >= (mind / 2) then
begin
l := l + MinD;
end;
l := l - wt;
if x > p1.x then
x := p1.x + l
else
x := p1.x - l;
d := abs(y - p1.y);
d := d + wt;
l := Trunc(d / minD) * mind;
dist := d - l;
if dist >= (mind / 2) then begin
l := l + MinD;
end;
l := l - wt;
if y > p1.y then
y := p1.y + l
else
y := p1.y - l;
end;
procedure TWallRect.UnLockTrace;
begin
xLocked := False;
yLocked := False;
end;
// Tolik - 10/07/2019 - ýòî ìîæåò ïîäúåáíóòü (ïðîâåðåíî!), òàê ÷òî ... ñòàðàÿ çàêîììåí÷åíà - ñì. íèæå
// çäåñü ðåçóëüòàò âû÷èñëåíèé ðàçáèò íà íåñêîëüêî ÷àñòåé, ò.ê. îäíèì âûðàæåíèåì Delphi ïî÷åìó-òî âû÷èñëÿåò íåïðàâèëüíî
// (ò.å. îò ñëîâà ñîâñåì, ò.ê. ïðè áîëüøèõ âåëè÷èíàõ â 100 000 èëè îò 50000 íåÿâíî âûäàñò, ÷òî òàì îøèáêà, ÷òî ïðè
// ðàáîòå ïðèëîæåíèÿ, êñòàòè, íå âûêàçûâàåòñÿ íèêàê, êðîìå íåïðàâèëüíîãî ðåçóëüòàòà ôóíêöèè)
// ïîýòîìó ââåäåíî åùå 2 ïåðåìåííûå (s1, s2) äëÿ ïðîìåæóòî÷íûõ ðåçóëüòàòîâ.
function PtInPoly(const poly: TDoublePointArr; p: TDoublePoint) : Boolean;
var i,j : integer;
s1, s2: double;
Begin
result := false;
j := High(poly);
For i := Low(poly) to High(poly) do
begin
s1 := (poly[j].x - poly[i].x);
s2 := (p.y - poly[i].y) / (poly[j].y - poly[i].y);
if (
( ((poly[i].y <= p.y) and (p.y < poly[j].y)) or ((poly[j].y <= p.y) and (p.y < poly[i].y)) ) and
(p.x < ( s1 * s2 + poly[i].x ) )
) then
result := not result;
j := i
end;
End;
(*
/////////////////////////// Ìèòÿé Ä. 30.12.2013 ///////////////////////////////
////////////////////// Ïðîâåðêà ïîïàäàíèÿ òî÷êè â ïîëèãîí ////////////////////
function PtInPoly(const poly: TDoublePointArr; p: TDoublePoint) : Boolean;
var i,j : integer;
Begin
result := false;
j := High(poly);
For i := Low(poly) to High(poly) do begin
if (
( ((poly[i].y <= p.y) and (p.y < poly[j].y)) or ((poly[j].y <= p.y) and (p.y < poly[i].y)) ) and
(p.x < ((poly[j].x - poly[i].x) * (p.y - poly[i].y) / (poly[j].y - poly[i].y) + poly[i].x))
) then
result := not result;
j := i
end;
{ if not result then
begin
For i := Low(poly) to High(poly) do
begin
if IsPointInLine(Poly[i], Poly[i+1], p, 1, 1) then
begin
Result := true;
Break; //// BREAK ////
end;
end;
end; }
End;
////////////////////////////////////////////////////////////////////////////////
*)
function IfFiguraIsRoof(AFigure: TObject): boolean;
const
JdiMenya = 9379992;
var
CSCCompon: TSCSComponent;
i: integer;
begin
result := false;
CSCCompon := nil;
if not (AFigure is TSCSComponent) then
CSCCompon := GetArchObjByCADObj(AFigure)
else
CSCCompon := TSCSComponent(AFigure);
if CSCCompon <> nil then
for i := 0 to CSCCompon.Properties.Count - 1 do
begin
if PProperty(CSCCompon.Properties[i]).SysName = 'MATERIAL_TYPE' then
begin
Result := true;
Break;
end;
if PProperty(CSCCompon.Properties[i]).SysName = 'RESIDUE' then
begin
Result := true;
Break;
end;
if PProperty(CSCCompon.Properties[i]).SysName = 'ROOF_HIP_TYPE' then
begin
Result := true;
Break;
end;
end;
end;
function CheckContrureEntry(AOuterConture, AInnerConture: PDoublePointArr;
ACheckNoInBorder: Boolean=false; ACheckNoAdjacent: Boolean=false; IsRoof: boolean=false): Boolean;
var
i, j: Integer;
HavePtNoInBorder: Boolean;
AllPtInBorder: Boolean;
PtExists, AllPtExists: Boolean;
TmpConture: TDoublePointArr;
begin
Result := false;
if (Length(AOuterConture^) >= 3) and (Length(AInnerConture^) >= 3) then
begin
Result := true;
// Ïðîâåðÿåì íàõîäèòñÿ ëè õîòü îäíà òî÷êà â ñðåäèíå êîíòóðà íå íà ãðàíèöå
if ACheckNoInBorder then
begin
//HavePtNoInBorder := false;
//for i := 0 to Length(AInnerConture^) - 1 do
//begin
// //if IsPtInPolygon(AInnerConture^[i], AOuterConture^, false, false) then
// //begin
// // HavePtNoInBorder := true;
// // Break; //// BREAK ////
// //end;
// for j := 1 to Length(AOuterConture^) - 1 do
// if Not IsPointInLine(AOuterConture^[j-1], AOuterConture^[j], AInnerConture^[i], 1) then
// begin
// HavePtNoInBorder := true;
// Break; //// BREAK ////
// end;
// if HavePtNoInBorder then
// Break; //// BREAK ////
//end;
//if Not HavePtNoInBorder then
//begin
// Result := false;
// Exit; ///// EXIT /////
//end;
// åñëè âñå òî÷êè AInnerConture íà îäíîé ãðàíè â AOuterConture,
for i := 1 to Length(AOuterConture^) - 1 do
begin
AllPtInBorder := true;
for j := 0 to Length(AInnerConture^) - 1 do
if Not IsPointInLine(AOuterConture^[i-1], AOuterConture^[i], AInnerConture^[j], 1) then
begin
AllPtInBorder := false;
Break; //// BREAK ////
end;
if AllPtInBorder then
begin
Result := false;
Exit; ///// EXIT /////
end;
end;
end;
// Ïðîâåðèòü íå ñìåæíûå ëè êîíòóðû - òîåñòü îäèí ÷åòêî ïîä äðóãèì
if ACheckNoAdjacent then
begin
if Length(AInnerConture^) = Length(AOuterConture^) then
begin
//TmpConture := AOuterConture^;
AllPtExists := true;
// Ïðîâåðÿåì åñòü ëè ñîîòâåòñòâèå êàæäîé òî÷êè îäíîãî ñåãìåíòà â äðóãîì
for i := 0 to Length(AInnerConture^) - 1 do
begin
PtExists := false;
for j := 0 to Length(AOuterConture^) - 1 do
if EQDP(AInnerConture^[i], AOuterConture^[j]) then
begin
PtExists := true;
//DeletePointFromArray(TmpConture, j);
Break; //// BREAK ////
end;
if Not PtExists then
begin
AllPtExists := false;
Break; //// BREAK ////
end;
end;
if AllPtExists then
Result := false;
end;
end;
if Result then
begin
for i := 0 to Length(AInnerConture^) - 1 do
begin
//Åñëè íå êðûøà, òîãäà äåëàòü òàê, êàê è ðàíüøå èíà÷å,ïî íîâîìó
if not IsRoof then
begin
//Åñëè õîòÿ áû îäíà òî÷êà íå âõîäèò â ïîëèãîí
if Not IsPtInPolygon(AInnerConture^[i], AOuterConture^, false, true) then
begin
//Òîãäà, ïîëó÷àåòñÿ, ÷òî êîíòóð íå âõîäèò...
Result := false;
Break; //// BREAK ////
end;
end
else
begin
if not PtInPoly(AOuterConture^, AInnerConture^[i]) then
begin
//Òîãäà, ïîëó÷àåòñÿ, ÷òî êîíòóð íå âõîäèò...
Result := false;
Break; //// BREAK ////
end;
end;
end;
end;
end;
end;
function CheckConturesEqual(AConture1, AConture2: PDoublePointArr): Boolean;
var
i: Integer;
begin
Result := false;
if Length(AConture1^) = Length(AConture2^) then
begin
Result := True;
for i := 0 to Length(AConture1^) - 1 do
begin
if Not EQDP(AConture1^[i], AConture2^[i]) then
begin
Result := false;
Break; //// BREAK ////
end;
end;
end;
end;
function CheckPtInNetConture(APoints: Pointer; ANet: TNet; AAnyPoint: Boolean): Boolean;
var
OutConture: TDoublePointArr;
InnConture: TDoublePointArr;
i: integer;
InCnt: integer;
begin
Result := false;
InCnt := 0;
// Ïîëó÷àåì êîíòóð äëÿ ANet
GetPathsConturePoints(ANet.Paths, @OutConture, @InnConture, {nil, nil,} false, nil, nil, nil, nil);
for i := 0 to Length(TDoublePointArr(Apoints^)) do
if IsPtInPolygon(TDoublePointArr(Apoints^)[i], @InnConture, false) then
begin
if AAnyPoint then
begin
Result := true;
Break; //// BREAK ////
end;
Inc(InCnt);
end
else
begin
if Not AAnyPoint then
begin
Result := false;
Break; //// BREAK ////
end;
end;
SetLength(OutConture, 0);
SetLength(InnConture, 0);
if Not AAnyPoint and (InCnt = Length(TDoublePointArr(Apoints^))) then
Result := true;
end;
procedure CleanSamePointsArr(var Arr: TDoublePointArr);
var
i,j: integer;
begin
for i := Length(Arr) - 1 downto 0 do
for j := i - 1 downto 0 do
begin
if EQDP(Arr[i], Arr[j]) then
begin
DeletePointFromArray(Arr, i);
Break; //// BREAK ////
end;
end;
end;
procedure GetPathsConturePoints(ANetPaths: TList; AResultOuter, AResultInner{, AOuterHeights, AInnerHeights}: Pointer; AWithHeights: Boolean;
AOutPaths, AInnPaths: TList; AOutPointIDs, AInnPointIDs: TList);
var
ConturePoints1: TDoublePointArr;
//ConturePointsHeights1: PDoubleArray;
ConturePointsID1: TList;
ContureLen1: Double;
ConturePoints2: TDoublePointArr;
//ConturePointsHeights2: PDoubleArray;
ConturePointsID2: TList;
ContureLen2: Double;
ConturePointsP: TDoublePointArr;
ConturePaths: TList;
ContureLenP: Double;
PCad: TPowerCad;
Area1, Area2, AreaP: Double;
FirstPath, LastPath: TNetPath;
DeltaCheckConture: Double;
StartPoint: TDoublePoint;
function GetPathPointByCoordType(APath: TNetPath; ACoordType: Integer): TDoublePoint;
begin
Result.x := 0;
Result.y := 0;
case ACoordType of
crtL1: Result := APath.el1;
crtL2: Result := APath.el2;
crtR1: Result := APath.er1;
crtR2: Result := APath.er2;
crtP1: Result := APath.p1^;
crtP2: Result := APath.p2^;
end;
end;
function GetPathPerpendPointByCoordType(APath: TNetPath; ACoordType: Integer): PDoublePoint;
begin
Result := nil;
case ACoordType of
crtL1: Result := APath.epl1;
crtL2: Result := APath.epl2;
crtR1: Result := APath.epr1;
crtR2: Result := APath.epr2;
end;
end;
function GetPathMiddlePtByCoordType(APath: TNetPath; ACoordType: Integer): PDoublePoint;
begin
Result := nil;
case ACoordType of
crtL1, crtR1, crtP1:
Result := APath.p1;
crtL2, crtR2, crtP2:
Result := APath.p2
end;
end;
procedure AddPointToArray(APoint: TDoublePoint; AHeight: Double; var AArray: TDoublePointArr{; AHeightsArray: PDoubleArray});
begin
SetLength(AArray, Length(AArray)+1);
AArray[Length(AArray)-1] := APoint;
//if AHeightsArray <> nil then
//begin
// SetLength(AHeightsArray^, Length(AHeightsArray^)+1);
// AHeightsArray^[Length(AHeightsArray^)-1] := AHeight;
//end;
if AWithHeights then
AArray[Length(AArray)-1].z := AHeight * (1000/ PCad.MapScale);
end;
// òî÷êè ëåæàùèå íà ñàìîì ñåãìåíòå (äëÿ òèïà àðêà)
// ABeginPoint - íà÷àëüíàÿ òî÷êà, äîáàâëåíà ïåðåä âíóòðåííèìè
// AEndPoint - êîí÷åíàÿ òî÷êè êîòîðàÿ áóäåò äîáàâëåíà ïîñëå âíóòðåííèõ
procedure GetPathPoints(APatch: TNetPath; var AConturePoints: TDoublePointArr; APointsID: TList; {AContureHeights: PDoubleArray;}
ABeginPoint, AEndPoint: TDoublePoint; AEndPointCoordType: Integer);
var
Fpoints: T2DPointArray;
Radius: Double;
a1,a2: Double;
Cnt: Integer;
i, idx: Integer;
p1, p2: TDoublePoint;
FPointsInOrder: Boolean; // Íîâûå òî÷êè äîáàâëÿòü â ïîðÿäêå êîòîðîì ïðèøëè, èëè îáðàòíîì
OldDxfMode: Boolean;
PathH: Double;
begin
if APatch.IsArc then
begin
p1 := DoublePoint(0,0,0);
p2 := DoublePoint(0,0,0);
if (AEndPointCoordType = crtL1) or (AEndPointCoordType = crtL2) then
begin
p1 := APatch.l1;
p2 := APatch.l2;
end
else if (AEndPointCoordType = crtR1) or (AEndPointCoordType = crtR2) then
begin
p1 := APatch.r1;
p2 := APatch.r2;
end;
Radius := GetLineLenght(p1, APatch.ArcCenter);
a1 := GetRadOfLine(APatch.ArcCenter, p1);
a2 := GetRadOfLine(APatch.ArcCenter, p2);
if Not APatch.Inverted then
ExchangeDouble(a1, a2);
OldDxfMode := DxfMode; // ïîâûøàåì òî÷íîñòü - êîëè÷åñòâî òî÷åê äëÿ äóãè
DxfMode := True;
try
BezierArcPoints(FPoints, APatch.ArcCenter.x, APatch.ArcCenter.y, Radius, a1, a2);
finally
DxfMode := OldDxfMode;
end;
Cnt := Length(FPoints);
if Cnt > 2 then
begin
//29.06.2012 FPointsInOrder := EQDP(ABeginPoint, DoublePoint(FPoints[0].x, FPoints[0].y));
FPointsInOrder := GetLineLength(ABeginPoint, DoublePoint(FPoints[0].x, FPoints[0].y)) < GetLineLength(ABeginPoint, DoublePoint(FPoints[Cnt-1].x, FPoints[Cnt-1].y));
PathH := 0;
if AWithHeights then //if AContureHeights <> nil then
PathH := APatch.GetHeight;
for i := 1 to cnt - 2 do
begin
if FPointsInOrder then
idx := i
else
idx := cnt - i - 1;
//AddPointToArray(DoublePoint(FPoints[idx].x, FPoints[idx].y), 0, AConturePoints, AContureHeights);
AddPointToArray(DoublePoint(FPoints[idx].x, FPoints[idx].y), PathH, AConturePoints{, AContureHeights});
if APointsID <> nil then
APointsID.Add(0);
end;
end;
end;
end;
//
function CmpPointsWithPerpend(p1, p1Perpend, p2, p2Perpend: PDoublePoint; var aUsedPrependPt: PDoublePoint): Boolean;
begin
Result := CmpPoints(p1^, p2^);
if Not Result then
begin
if p1Perpend <> nil then
begin
Result := CmpPoints(p1Perpend^, p2^);
// Çäåñü íå óñòàíàâëèâàåì aUsedPrependPt, òàê êàê â ïîñëåäíåì ýëåìåíòå ìàññèâå óæå åñòü
//if Result then
// aUsedPrependPt := p1Perpend;
//01.06.2012 ñòàâèì p1, òàê êàê ñþäà ïîïàëè èç ïåðïåíäèêóëÿðíîé òî÷êè p1Perpend
if Result then
aUsedPrependPt := p1;
end;
if Not Result and (p2Perpend <> nil) then
begin
Result := CmpPoints(p1^, p2Perpend^);
if Result then
aUsedPrependPt := p2Perpend;
end;
end;
end;
function GetConnectedPathByCoordType(APath: TNetPath; APathList: TList; ACoordType: Integer;
AConnCoordType: PInteger; var aUsedPrependPt: PDoublePoint): TNetPath;
var
PathPoint: TDoublePoint;
PathPerpendPoint: PDoublePoint;
UsedPrependPt: PDoublePoint;
i, j: Integer;
SPath: TNetPath;
RelCoordTypeAtSide: Integer;
RelPointAtSide: TDoublePoint;
ConnCoordType: Integer;
ResFromRel: Boolean;
ResLenToStartPt, LenToStartPt: Double;
LastIsResFromRel: Boolean;
SPathEList: TList;
SPathEPList: TList;
SPathCoordType: TList;
begin
Result := nil;
SPathEList := nil;
SPathEPList := nil;
SPathCoordType := nil;
ResFromRel := false;
LastIsResFromRel := false;
ResLenToStartPt := 0;
PathPoint := GetPathPointByCoordType(APath, ACoordType);
PathPerpendPoint := nil;
if Not APath.isArc then
PathPerpendPoint := GetPathPerpendPointByCoordType(APath, ACoordType)
else
begin
SPathEList := TList.Create;
SPathEPList := TList.Create;
SPathCoordType := TList.Create;
APath.FillArcJoinPoints(SPathEList, SPathEPList);
for i := 0 to SPathEList.Count - 1 do
begin
if CmpPoints(PDoublePoint(SPathEList[i])^, PathPoint) then
begin
if Not EQDP(PDoublePoint(SPathEList[i])^, PDoublePoint(SPathEPList[i])^) then
begin
PathPerpendPoint := SPathEPList[i];
Break; //// BREAK ////
end;
end
else if CmpPoints(PDoublePoint(SPathEPList[i])^, PathPoint) then
begin
if Not EQDP(PDoublePoint(SPathEPList[i])^, PDoublePoint(SPathEList[i])^) then
begin
EmptyProcedure;
// PathPerpendPoint := SPathEList[i];
// Break; //// BREAK ////
end;
end;
end;
end;
// Äðóãîé òèï òî÷êè íà ýòîé æå ñòîðîíå
RelCoordTypeAtSide := GetRelCoordTypeAtSide(ACoordType);
// Äðóãàÿ òî÷êà íà ýòîé æå ñòîðîíå
RelPointAtSide := GetPathPointByCoordType(APath, RelCoordTypeAtSide);
aUsedPrependPt := nil;
for i := 0 to APathList.Count - 1 do
begin
SPath := TNetPath(APathList[i]);
if SPath <> APath then
if APath.Connected(SPath) then
begin
if EQDP(SPath.p1^, SPath.p2^) then
begin
EmptyProcedure;
Continue; //// CONTINUE ////
end;
ConnCoordType := -1;
UsedPrependPt := nil;
if ACoordType in [crtL1, crtL2, crtR1, crtR2] then
begin
{
////if ACoordType in [crtL1, crtL2] then
////begin
if CmpPointsWithPerpend(@SPath.el1, SPath.epl1, @PathPoint, PathPerpendPoint, UsedPrependPt) then
begin
ConnCoordType := crtL1;
ResFromRel := false;
end
else if CmpPointsWithPerpend(@SPath.el2, SPath.epl2, @PathPoint, PathPerpendPoint, UsedPrependPt) then
begin
ConnCoordType := crtL2;
ResFromRel := false;
end
// else if CmpPoints(SPath.er1, RelPointAtSide) then
// begin
// ConnCoordType := crtR1; //20.09.2011 GetRelCoordTypeAtSide(crtR1);
// ResFromRel := true;
// end
// else if CmpPoints(SPath.er2, RelPointAtSide) then
// begin
// ConnCoordType := crtR2; //20.09.2011 GetRelCoordTypeAtSide(crtR2);
// ResFromRel := true;
// end
////end
////else if ACoordType in [crtR1, crtR2] then
////begin
else if CmpPointsWithPerpend(@SPath.er1, SPath.epr1, @PathPoint, PathPerpendPoint, UsedPrependPt) then
begin
ConnCoordType := crtR1;
ResFromRel := false;
end
else if CmpPointsWithPerpend(@SPath.er2, SPath.epr2, @PathPoint, PathPerpendPoint, UsedPrependPt) then
begin
ConnCoordType := crtR2;
ResFromRel := false;
end;
//else if CmpPoints(SPath.el1, RelPointAtSide) then
//begin
// ConnCoordType := crtL1; //20.09.2011 GetRelCoordTypeAtSide(crtL1);
// ResFromRel := true;
//end
//else if CmpPoints(SPath.el2, RelPointAtSide) then
//begin
// ConnCoordType := crtL2; //20.09.2011 GetRelCoordTypeAtSide(crtL2);
// ResFromRel := true;
//end;
}
if SPathEList = nil then
begin
SPathEList := TList.Create;
SPathEPList := TList.Create;
SPathCoordType := TList.Create;
end;
SPathEList.Clear;
SPathEPList.Clear;
SPathCoordType.Clear;
// L1
SPathEList.Add(@SPath.el1);
SPathEPList.Add(SPath.epl1);
SPathCoordType.Add(Pointer(crtL1));
// L2
SPathEList.Add(@SPath.el2);
SPathEPList.Add(SPath.epl2);
SPathCoordType.Add(Pointer(crtL2));
// R1
SPathEList.Add(@SPath.er1);
SPathEPList.Add(SPath.epr1);
SPathCoordType.Add(Pointer(crtR1));
// R2
SPathEList.Add(@SPath.eR2);
SPathEPList.Add(SPath.epR2);
SPathCoordType.Add(Pointer(crtR2));
for j := 0 to SPathEList.Count - 1 do
begin
if CmpPointsWithPerpend(SPathEList[j], SPathEPList[j], @PathPoint, PathPerpendPoint, UsedPrependPt) then
begin
ConnCoordType := Integer(SPathCoordType[j]);
ResFromRel := false;
Break; //// BREAK ////
end
end;
if ConnCoordType = -1 then
begin
if SPath.isArc then
begin
SPath.FillArcJoinPoints(SPathEList, SPathEPList);
for j := 0 to SPathEList.Count - 1 do
begin
if CmpPoints(PDoublePoint(SPathEList[j])^, PathPoint) then
begin
UsedPrependPt := SPathEPList[j];
ConnCoordType := GetCoordTypeByPt(SPathEPList[j], SPath);
Break; //// BREAK ////
end
else if CmpPoints(PDoublePoint(SPathEPList[j])^, PathPoint) then
begin
UsedPrependPt := SPathEList[j];
ConnCoordType := GetCoordTypeByPt(SPathEList[j], SPath);
Break; //// BREAK ////
end
end;
end;
end;
end
else if ACoordType in [crtP1, crtP2] then
begin
if CmpPoints(SPath.p1^, PathPoint) then
ConnCoordType := crtP1
else if CmpPoints(SPath.P2^, PathPoint) then
ConnCoordType := crtP2;
end;
if UsedPrependPt <> nil then
ResFromRel := true;
if ConnCoordType <> -1 then
begin
//LenToStartPt := GetLineLenght(StartPoint, GetPathPointByCoordType(SPath, ConnCoordType));
if (Result = nil) or (LenToStartPt < ResLenToStartPt) or (LastIsResFromRel and EQD(LenToStartPt, ResLenToStartPt)) then
begin
ResLenToStartPt := LenToStartPt;
aUsedPrependPt := UsedPrependPt;
Result := SPath;
if AConnCoordType <> nil then
AConnCoordType^ := ConnCoordType;
LastIsResFromRel := ResFromRel;
if Not ResFromRel then
//if Not EQDP(SPath.p1^, SPath.p2^) then
begin
Break; //// BREAK ////
end;
//else
// EmptyProcedure;
end;
end;
end;
end;
if SPathEList <> nil then
begin
SPathEList.Free;
SPathEPList.Free;
SPathCoordType.Free;
end;
if Result = nil then
EmptyProcedure;
end;
procedure DefineContureFromPoint(var AConturePoints: TDoublePointArr; APointsID: TList; {AContureHeights: PDoubleArray;}
AStartPath: TNetPath; ACoordType: Integer);
var
NetPaths: TList;
CurrPath, PrevPath: TNetPath;
CurrPathCoordType: Integer;
CurrPathPoint: TDoublePoint;
CurrPathRelCoordType: Integer;
CurrPathRelPoint: TDoublePoint;
ConnPathCoordType: Integer;
MPt: PDoublePoint;
StartPathPtH, PathPtH: Double;
StartPrependPt, UsedPrependPt: PDoublePoint;
RelPrependPt: PDoublePoint;
ContureLen: Integer;
begin
SetLength(AConturePoints, 0);
//DefineContureStep(AStartPath, ACoordType);
if ConturePaths <> nil then
ConturePaths.Clear;
NetPaths := TList.Create;
NetPaths.Assign(ANetPaths);
CurrPathCoordType := ACoordType;
StartPrependPt := nil;
CurrPathPoint := GetPathPointByCoordType(AStartPath, ACoordType);
if AStartPath.isArc then
StartPrependPt := AStartPath.GetArcLPointByPt(@CurrPathPoint)
else
StartPrependPt := GetPathPerpendPointByCoordType(AStartPath, ACoordType);
CurrPath := AStartPath;
PrevPath := nil;
StartPoint := CurrPathPoint;
MPt := GetPathMiddlePtByCoordType(AStartPath, ACoordType);
StartPathPtH := 0;
PathPtH := 0;
if AWithHeights then //if AContureHeights <> nil then
PathPtH := AStartPath.GetHeightOfPt(MPt);
if APointsID <> nil then
APointsID.Add(Pointer(AStartPath.Net.GetPointID(MPt)));
if StartPrependPt <> nil then
begin
StartPoint := StartPrependPt^;
StartPathPtH := PathPtH;
AddPointToArray(StartPrependPt^, PathPtH, AConturePoints);
end;
AddPointToArray(CurrPathPoint, PathPtH, AConturePoints{, AContureHeights});
while CurrPath <> nil do
begin
if ConturePaths <> nil then
ConturePaths.Add(CurrPath);
//if (CurrPath.epl1 = nil) and (CurrPath.epl2 = nil) and (CurrPath.epr1 = nil) and (CurrPath.epr2 = nil) then
NetPaths.Remove(CurrPath);
// íàõîäèì âòîðóþ òî÷êó ñåãìåíòà, è äîáàâëÿåì åå â ìàññèâ
CurrPathRelCoordType := GetRelCoordType(CurrPathCoordType);
CurrPathRelPoint := GetPathPointByCoordType(CurrPath, CurrPathRelCoordType);
// Âíóòðåííèå òî÷êè
//GetPathPoints(CurrPath, CurrPathPoint, CurrPathRelPoint, CurrPathRelCoordType);
GetPathPoints(CurrPath, AConturePoints, APointsID, {AContureHeights, }CurrPathPoint, CurrPathRelPoint, CurrPathRelCoordType);
MPt := GetPathMiddlePtByCoordType(CurrPath, CurrPathRelCoordType);
PathPtH := 0;
if AWithHeights then //if AContureHeights <> nil then
PathPtH := CurrPath.GetHeightOfPt(MPt);
if APointsID <> nil then
APointsID.Add(Pointer(AStartPath.Net.GetPointID(MPt)));
AddPointToArray(CurrPathRelPoint, PathPtH, AConturePoints {, AContureHeights});
if EQDPZ(StartPoint, CurrPathRelPoint) then
begin
Break; //// BREAK ////
end
else
begin
PrevPath := CurrPath;
CurrPath := GetConnectedPathByCoordType(CurrPath, NetPaths, CurrPathRelCoordType, @ConnPathCoordType, UsedPrependPt);
if CurrPath <> nil then
begin
CurrPathCoordType := ConnPathCoordType; //CurrPathRelCoordType;
// Óäàëÿåì ñåãìåíò èç ñïèñêà äëÿ ïîèñêà
// AStartPath - áóäåò óäàëåí ïîñëåäíèì, åñëè êîíòóð çàìêíóòûé - ÷òîáû â êîíöå íà íåãî îïÿòü ïðèøëè
//NetPaths.Remove(CurrPath);
//01.06.2012 - Åñëè íà íîâûé ñåãìåíò CurrPath âûøëè ÷åðåç ïåðïåíäèêóëÿðíóþ òî÷êó, òî ïðîâåðèòü íåáûëî ëè ïåðïåíäèêóëÿðíîé òî÷êè â íà÷àëå ýòîãî ñåãìåíòà
//if UsedPrependPt <> nil then
//begin
// RelPrependPt := GetPathPerpendPointByCoordType(CurrPath, GetRelCoordType(CurrPathCoordType));
// if RelPrependPt <> nil then
// AddPointToArray(RelPrependPt^, PathPtH, AConturePoints);
//end;
//21.05.2012 - Åñëè ñâÿçü ÷åðåç ïåðïåíäèêóëÿðíóþ òî÷êó, òî ñûñîòó áåðåì ïî ïðåäûäóùåé òî÷êå, òàê êàê îíà ïî÷òè íà òîì æå ìåñòå
end
else
if UsedPrependPt = nil then
// Åñëè íå âûøëè íà ïóòü èñòåííûé, òî ñìîòðèì íåò ëè ïåðïåíäèêóëÿðíîé òî÷êè
UsedPrependPt := GetPathPerpendPointByCoordType(PrevPath, CurrPathRelCoordType);
if UsedPrependPt <> nil then
begin
AddPointToArray(UsedPrependPt^, PathPtH, AConturePoints);
if EQDP(StartPoint, UsedPrependPt^) then
Break; //// BREAK ////
end;
CurrPathPoint := CurrPathRelPoint; //26.10.2010
end;
end;
//07.06.2012 Åñëè íà÷àëè ñ ïåðïåíäèêóëÿðíîé òî÷êè, òî äîáàâëÿåì åå â êîíåö, ÷òîáû ïðîõîäèëà ïðîâåðêà íà âàëèäíîñòü çàìêíóòîãî êîíòóðà
if StartPrependPt <> nil then
begin
ContureLen := Length(AConturePoints);
//AddPointToArray(StartPrependPt^, StartPathPtH, AConturePoints);
if (ContureLen >= 3) and EQDP(AConturePoints[1], AConturePoints[ContureLen-1]) then
AConturePoints[ContureLen-1] := AConturePoints[0];
end;
FreeAndNil(NetPaths);
end;
function IsValidConture(var AConturePoints: TDoublePointArr): Boolean;
begin
Result := false;
if Length(AConturePoints) > 2 then
//18.04.2011 if CmpPoints(AConturePoints[0], AConturePoints[length(AConturePoints)-1]) then
if PointNear(AConturePoints[0], AConturePoints[length(AConturePoints)-1], DeltaCheckConture) then
begin
Result := true;
end;
end;
function GetContureLen(var AConturePoints: TDoublePointArr): Double;
var
i: Integer;
begin
Result := 0;
for i := 1 to Length(AConturePoints) - 1 do
begin
Result := Result + GetLineLenght(AConturePoints[i-1], AConturePoints[i]);
end;
end;
begin
if AResultOuter <> nil then
SetLength(TDoublePointArr(AResultOuter^), 0);
if AResultInner <> nil then
SetLength(TDoublePointArr(AResultInner^), 0);
//if AOuterHeights <> nil then
// SetLength(TDoubleArray(AOuterHeights^), 0);
//if AInnerHeights <> nil then
// SetLength(TDoubleArray(AInnerHeights^), 0);
ConturePaths := nil;
if ANetPaths.Count > 0 then
begin
PCad := TPowerCad(TNetPath(ANetPaths[0]).Net.Owner);
if Assigned(AOutPaths) or Assigned(AInnPaths) then
ConturePaths := TList.Create;
FirstPath := TNetPath(ANetPaths[0]);
LastPath := TNetPath(ANetPaths[ANetPaths.Count-1]);
DeltaCheckConture := 1;
if FirstPath.isArc or LastPath.isArc then
DeltaCheckConture := Max(FirstPath.Width, LastPath.Width);
//ConturePointsHeights1 := nil;
//ConturePointsHeights2 := nil;
//if (AOuterHeights <> nil) or (AInnerHeights <> nil) then
//begin
// ConturePointsHeights1 := AllocMem(SizeOf(TDoubleArray));
// ConturePointsHeights2 := AllocMem(SizeOf(TDoubleArray));
//end;
ConturePointsID1 := nil;
ConturePointsID2 := nil;
if (AOutPointIDs <> nil) or (AInnPointIDs <> nil) then
begin
ConturePointsID1 := TList.Create;
ConturePointsID2 := TList.Create;
end;
DefineContureFromPoint(ConturePoints1, ConturePointsID1, {ConturePointsHeights1, }TNetPath(ANetPaths[0]), crtL1);
ContureLen1 := 0;
if IsValidConture(ConturePoints1) then
begin
ContureLen1 := GetContureLen(ConturePoints1);
if AResultOuter <> nil then
TDoublePointArr(AResultOuter^) := ConturePoints1;
if AResultInner <> nil then
TDoublePointArr(AResultInner^) := ConturePoints1;
//if AOuterHeights <> nil then
// TDoubleArray(AOuterHeights^) := ConturePointsHeights1^;
//if AInnerHeights <> nil then
// TDoubleArray(AInnerHeights^) := ConturePointsHeights1^;
if AOutPointIDs <> nil then
AOutPointIDs.Assign(ConturePointsID1);
if AInnPointIDs <> nil then
AInnPointIDs.Assign(ConturePointsID1);
if Assigned(AOutPaths) then
AOutPaths.Assign(ConturePaths);
if Assigned(AInnPaths) then
AInnPaths.Assign(ConturePaths);
end;
DefineContureFromPoint(ConturePoints2, ConturePointsID2, {ConturePointsHeights2,} TNetPath(ANetPaths[0]), crtR1);
ContureLen2 := 0;
if IsValidConture(ConturePoints2) then
begin
ContureLen2 := GetContureLen(ConturePoints2);
if (AResultOuter <> nil) and (ContureLen2 > ContureLen1) then
begin
TDoublePointArr(AResultOuter^) := ConturePoints2;
//if AOuterHeights <> nil then
// TDoubleArray(AOuterHeights^) := ConturePointsHeights2^;
if AOutPointIDs <> nil then
AOutPointIDs.Assign(ConturePointsID2);
if ConturePaths <> nil then
AOutPaths.Assign(ConturePaths);
end;
if (AResultInner <> nil) and ((ContureLen2 < ContureLen1) or (ContureLen1 = 0)) then
begin
TDoublePointArr(AResultInner^) := ConturePoints2;
//if AInnerHeights <> nil then
// TDoubleArray(AInnerHeights^) := ConturePointsHeights2^;
if AInnPointIDs <> nil then
AInnPointIDs.Assign(ConturePointsID2);
if ConturePaths <> nil then
AInnPaths.Assign(ConturePaths);
end;
end;
//if (AOuterHeights <> nil) or (AInnerHeights <> nil) then
//begin
// FreeMem(ConturePointsHeights1);
// FreeMem(ConturePointsHeights2);
// ConturePointsHeights1 := nil;
// ConturePointsHeights2 := nil;
//end;
if (AOutPointIDs <> nil) or (AInnPointIDs <> nil) then
begin
FreeAndNil(ConturePointsID1);
FreeAndNil(ConturePointsID2);
end;
// Äëÿ òåñòà
//DefineContureFromPoint(ConturePointsP, TNetPath(ANetPaths[0]), crtP1);
// ContureLenP := 0;
// if IsValidConture(ConturePointsP) then
// begin
// ContureLenP := GetContureLen(ConturePointsP);
// end;
//
// PCad := TPowerCad(TNetPath(ANetPaths[0]).Net.Owner);
// if PCad <> nil then
// begin
// Area1 := GetAreaFromPolygonM(PCad, ConturePoints1);
// Area2 := GetAreaFromPolygonM(PCad, ConturePoints2);
// AreaP := GetAreaFromPolygonM(PCad, ConturePointsP);
// end;
if ConturePaths <> nil then
FreeAndNil(ConturePaths);
end;
end;
procedure ClearJoinedParamsInNets(ANetList: TList);
var
i: Integer;
Net: TNet;
begin
for i := 0 to ANetList.Count - 1 do
begin
Net := ANetList[i];
Net.FJoinedMovePoints.Clear;
Net.FJoinedMovePointsDirections.Clear;
Net.FJoinedMovePointsFixedState.Clear;
Net.FJoinedMovePaths.Clear;
Net.FJoinedMovePathsDirections.Clear;
end;
end;
function CreatePolygonRgnByPoints(DEngine: TPCDrawEngine; p1,p2,p3,p4: PDoublePoint): HRGN;
var
pArr:TPointArr;
i: Integer;
xx,yy,z:Double;
Points: TList;
reg: Integer;
begin
Points := TList.Create;
Points.Add(p1);
Points.Add(p2);
Points.Add(p3);
Points.Add(p4);
SetLength(pArr, 4);
for i := 0 to Points.Count - 1 do
begin
z := 0;
xx := PDoublePOint(Points[i]).x;
yy := PDoublePOint(Points[i]).y;
DEngine.ConvertPoint(xx,yy,z);
PArr[i] := Point(round(xx),round(yy));
end;
Result := Dengine.PolygonRegion(pArr);
Points.Free;
//Tolik
SetLength(pArr,0);
//
end;
function GetAllNets(aPCad: TPowerCad): TList;
procedure LookFigures(aFigures: TList);
var
i: Integer;
Figure: TFigure;
begin
for i := 0 to aFigures.Count - 1 do
begin
Figure := TFigure(aFigures[i]);
if (Figure is TNet) then
Result.Add(Figure)
else
if Figure is TfigureGrp then
LookFigures(TFigureGrp(Figure).InFigures);
end;
end;
begin
Result := TList.Create;
LookFigures(aPCad.Figures);
end;
function GetCoordTypeByPt(aPt: PDoublePoint; aPath: TNetPath): Integer;
begin
Result := -1;
if EQDP(aPt^, aPath.er1) then
Result := crtR1
else if EQDP(aPt^, aPath.er2) then
Result := crtR2
else if EQDP(aPt^, aPath.el1) then
Result := crtL1
else if EQDP(aPt^, aPath.el2) then
Result := crtL2;
end;
function GetNetsByPoints(aPCad: TPowerCad; p1, p2: PDoublePoint; aNetsPath: TList=nil): TList;
var
i, j: Integer;
Nets: TList;
Net: TNet;
Path: TNetPath;
PointsInPath: Boolean;
begin
Result := TList.Create;
if aNetsPath <> nil then
aNetsPath.Clear;
Nets := GetAllNets(aPCad);
for i := 0 to Nets.Count - 1 do
begin
Net := TNet(Nets[i]);
for j := 0 to Net.Paths.Count - 1 do
begin
Path := TNetPath(Net.Paths[j]);
PointsInPath := Path.IsPointIn(p1^.x, p1.y, false);
if PointsInPath and (p2 <> nil) then
PointsInPath := Path.IsPointIn(p2^.x, p2.y, false);
if PointsInPath then
begin
Result.Add(Net);
if aNetsPath <> nil then
aNetsPath.Add(Path);
Break; //// BREAK ////
end;
end;
end;
Nets.Free;
end;
function GetOtherSide(aSide: Integer): Integer;
begin
if aSide = 1 then
Result := 2
else
Result := 1
end;
// Âåðíåò òèï êîîðäèíàòû íà äðóãîé ñòîðîíå ñåãìåíòà
function GetRelCoordType(ACoordType: Integer): Integer;
begin
Result := 0;
case ACoordType of
crtL1:
Result := crtL2;
crtL2:
Result := crtL1;
crtR1:
Result := crtR2;
crtR2:
Result := crtR1;
crtP1:
Result := crtP2;
crtP2:
Result := crtP1;
end;
end;
// Âåðíåò òèï êîîðäèíàòû íà ýòîé ñòîðîíå ñåãìåíòà
function GetRelCoordTypeAtSide(ACoordType: Integer): Integer;
begin
Result := 0;
case ACoordType of
crtL1:
Result := crtR1;
crtL2:
Result := crtR2;
crtR1:
Result := crtL1;
crtR2:
Result := crtL2;
crtP1:
Result := crtP1;
crtP2:
Result := crtP2;
end;
end;
function IsPtInArray(APt: TDoublePoint; APointArray: PDoublePointArr): Boolean;
var
i: Integer;
begin
Result := false;
for i := 0 to Length(APointArray^) - 1 do
begin
if EQDP(APt, APointArray^[i]) then
begin
Result := true;
Break; //// BREAK ////
end;
end;
end;
// APointsAsLines=true ãîâîðèò ÷òî â ìàññèâå äëÿ êàæäîé ëèíèè òî÷êè îòäåëüíî,
// òîåñòü îäíà òî÷êà â êîòîðîé ñõîäÿòñÿ ëèíèè â ìàññèâå äâà ðàçà
function IsPtInPolygon(APt: TDoublePoint; APollygonPaths: TDoublePointArr; APointsAsLines:Boolean=true; AllowCommonPoint:Boolean=false; AMul: Integer=0): Boolean;
var
MaxX: Double; //Ìàêñèìàëüíûé Õ ïîëèãîíà
VPoint: TDoublePoint; //Òî÷êà, êîòîðàÿ áîëüøå ìàêñèìàëüíîãî Õ íà 100
i: Integer;
CrossCount: Integer; //Êîëè÷åñòâî ïåðåñå÷åíèé ëèíèè Apt-VPoint ñ äðóãèìè ëèíèÿìè
ip: TDoublePoint; //Ñàìà òî÷êà ïåðåñå÷åíèÿ
WhileTo: Integer; //Êîëè÷åñòâî òî÷åê ïîëèãîíà
NextPtIdx: Integer; //Èíäåêñ ñëåäóþùåé òî÷êè
CrossPoints: TDoublePointArr; //Ìàññèâ òî÷åê ïåðåñå÷åíèÿ
CanAddCross: Boolean;
begin
Result := false;
// Íàõîäèòñÿ ëè òî÷êà âíóòðè ìíîãîóãîëüíèêà, îïðåäåëÿåì ìåòîòîì ïîèñêà êîëè÷åñòâà ëèíèé
// êîòîðîå ïåðåñåêàåòñÿ ñ âèðòóàëüíîé ëèíèåé (îò òî÷êè â ïðàâî äî áåñêîíå÷íîñòè)
// åñëè êîë-âî ïåðåñå÷åíèå 0 èëè ÷åòíîå, òî íå âõîäèò, à åñëè íå÷åòíîå - òî âõîäèò
if Length(APollygonPaths) > 0 then
begin
if AMul <> 0 then
begin
APt.x := APt.x * AMul;
APt.y := APt.y * AMul;
end;
// Îïðåäåëÿåì íàèáîëüøèé X
MaxX := APt.x;
for i := 0 to Length(APollygonPaths) - 1 do
begin
if AMul <> 0 then
begin
APollygonPaths[i].x := APollygonPaths[i].x * AMul;
APollygonPaths[i].y := APollygonPaths[i].y * AMul;
end;
if APollygonPaths[i].x > MaxX then
MaxX := APollygonPaths[i].x;
end;
VPoint.x := MaxX + 100;
VPoint.y := APt.y;
CrossCount := 0;
i := 0;
WhileTo := 0;
if APointsAsLines then
WhileTo := (Length(APollygonPaths) - 2)
else
WhileTo := (Length(APollygonPaths) - 1);
SetLength(CrossPoints, 0);
while i <= WhileTo do
begin
NextPtIdx := i+1;
// Åñëè ñìîòðèì íà ïîñëåäíþþ òî÷êó, òî ñëåäóþùåé áóäåò ïåðâàÿ
if i = (Length(APollygonPaths)-1) then
NextPtIdx := 0;
if Not EQDP(APollygonPaths[i], APollygonPaths[NextPtIdx]) then
//PCTypesUtils.Intersect(APt, VPoint, APollygonPaths[i], APollygonPaths[i+1]);
//02.08.2011 if LinesCross(APt, VPoint, APollygonPaths[i], APollygonPaths[i+1], AllowCommonPoint) then
//Åñëè ëèíèè À(APt.x, APt.y)Â(VPoint.x, VPoint.y) è
//Ñ(APollygonPaths[i].x,APollygonPaths[i].y)Í(APollygonPaths[NextPtIdx].x,APollygonPaths[NextPtIdx].y)
//ïåðåñåêàþòñÿ
if LinesCross(APt, VPoint, APollygonPaths[i], APollygonPaths[NextPtIdx], false) then
begin
CanAddCross := true;
//íàõîäèì òî÷êó ïåðåñå÷åíèÿ
if GetInterSectionPoint(APt, VPoint, APollygonPaths[i], APollygonPaths[NextPtIdx], ip, false) then
begin
//ïðîâåðêà âõîæäåíèÿ ñàìîé ñåáÿ
{if IsPtInArray(APollygonPaths[i], @CrossPoints) then
CrossCount := CrossCount + 1;}
{ if IsPtInArray(ip, @APollygonPaths)then //Åñëè òî÷êà ïåðåñå÷åíèÿ ip ïðåíàäëåæèò ïîëèãîíó APollygonPaths
begin
if IsPtInArray(APt, @APollygonPaths) then //Åñëè ïðîâåðÿåìàÿ òî÷êà APt ïðåíàäëåæèò ýòîìó ïîëèãîíó
begin
if AllowCommonPoint then //Åñëè óêàçàíî ðàçðåøèòü îáùóþ òî÷êó
begin
CrossCount := 1;
Break;
end;
end
end
else
begin }
// Åñëè áûëà òàêàÿ òî÷êà ïåðåñå÷åíèÿ
if IsPtInArray(ip, @CrossPoints) then
CanAddCross := false
else
begin
SetLength(CrossPoints, Length(CrossPoints)+1);
CrossPoints[Length(CrossPoints)-1] := ip;
end;
if CanAddCross then
CrossCount := CrossCount + 1;
// end;
end;
end;
if APointsAsLines then
i := i+2
else
i := i+1;
end;
SetLength(CrossPoints, 0);
Result := (CrossCount <> 0) and ((CrossCount mod 2) <> 0);
//02.08.2011 Åñëè ïåðåñå÷åíèé íå íàøëè è äîïóñêàåòñÿ åñëè ïåðåñå÷åíèå âïðèòûê
if Not Result and AllowCommonPoint then
begin
i := 0;
//Åñëè íå íàøëè ïåðåñå÷åíèé, ïðîâåðÿåì, íå ëåæèò ëè òî÷êà íà ïðÿìîé
// Tolik 18/11/2019 -- à âîò ýòî - ïðîåá, ò.ê. êîãäà i = WhileTo, APollygonPaths[i+1] - óæå çà ïðåäåëàìè ìàññèâà,
// ïîòîìó ÷òî ìàññèâ áåðåì ñ íóëÿ...
//while i <= WhileTo do
if Length(APollygonPaths) > 1 then // Tolik 18/11/2019 -- íà âñÿêèé ...
begin
while i <= WhileTo do // Tolik 18/11/2019 -- îñòàâëÿåì òàê, ÷òîáû ïðîñêî÷èëî ïåðâûé ðàç, åñëè ýëåìåíòîâ
//ìàññèâà âäðóã âñåãî ëèøü äâà, à ìàññèâ ïðåäñòàâëåí ëèíèÿìè
//
begin
if IsPointInLine(APollygonPaths[i], APollygonPaths[i+1], APt, 1, 1) then
begin
Result := true;
Break; //// BREAK ////
end;
if APointsAsLines then
i := i+2
else
i := i+1;
if i = WhileTo then // Tolik 18/11/2019 -- âîò çäåñü ñáðîñèì, ÷òîáû íå âûñêî÷èòü çà ïðåäåëû ìàññèâà...
break;
end;
end;
end;
end;
end;
function GetNetObjInPoint(PCAD: TPCDrawing; LayerNbr:Integer; x,y: Double; OnlyNet: Boolean=false): TObject;
var
i, a: Integer;
Figure: TFigure;
invis: boolean;
begin
Result := nil;
for i := 0 to PCAD.Figures.Count - 1 do
begin
a := PCAD.figures.count - 1 - i;
Figure := TFigure(PCAD.figures[a]);
if Figure is TNet then
begin
invis := false;
if (Figure.LayerHandle <> 0) then
invis := (TLayer(Figure.LayerHandle).Visible = lost);
if (not invis) and ((LayerNbr = 0) or (Figure.LayerHandle = LongInt(PCAD.Layers[LayerNbr]))) then
begin
Result := TNet(Figure).GetObjInPoint(x,y);
if Result <> nil then
begin
if OnlyNet then
Result := Figure;
Break; //// BREAK ////
end;
end;
end;
end;
end;
Function PointNear(p1,p2: TDoublePoint; delta: Double=1):Boolean;
begin
//result := (abs(p1.x - p2.x) <= 1) and (abs(p1.y - p2.y) <= 1);
result := (abs(p1.x - p2.x) <= delta) and (abs(p1.y - p2.y) <= delta);
end;
function ScaleConturePoints(var APoints: TDoublePointArr; ASize: Double): Boolean;
var
PointCnt: Integer;
Net: TNet;
Path: TNetPath;
PathWidth: Double;
PathPoints: TDoublePointArr;
i: integer;
OutPoints: TDoublePointArr;
InnPoints: TDoublePointArr;
isroof: boolean;
begin
Result := false;
PointCnt := Length(APoints);
// ïåðâàÿ è ïîñëåäíÿÿ òî÷êè äîëæíû ñîâïàäàòü
if (PointCnt > 0) and (ASize <> 0) and EQDP(APoints[0], APoints[PointCnt-1]) then
begin
Net := TNet.Create(0, mydsNormal, nil);
try
SetLength(PathPoints, 2);
PathWidth := ASize * 2;
for i := 1 to Length(APoints)-1 do //14.10.2010 for i := 1 to 4 do
begin
PathPoints[0] := APoints[i-1];
PathPoints[1] := APoints[i];
Path := Net.MakePath(PathPoints, false);
if Path <> nil then
Path.Width := PathWidth;
end;
Net.RefreshPaths;
Net.SetModified; //03.02.2012 Net.ResetRegion;
// Ïîëó÷àåì âíåøí/âíóòð êîíòóðû
GetPathsConturePoints(Net.Paths, @OutPoints, @InnPoints, {nil, nil,} false, nil, nil, nil, nil);
// Ïðîâåðÿåì, âõîäèò ëè îäèí êîíòóð âî âòîðîé
if (Length(OutPoints) > 0) and (Length(InnPoints) > 0) then
begin
isroof := iffiguraisroof(net);
if CheckContrureEntry(@OutPoints, @InnPoints,false,false,isroof) then
begin
SetLength(APoints, 0);
if ASize > 0 then
APoints := OutPoints
else
APoints := InnPoints;
end;
end;
SetLength(OutPoints, 0);
SetLength(InnPoints, 0);
finally
Net.Free;
end;
end;
end;
initialization
if FigureClasses.IndexOf(TNet) = -1 then
FigureClasses.Add(TNet);
if FigureClasses.IndexOf(TWallPath) = -1 then
FigureClasses.Add(TWallPath);
if FigureClasses.IndexOf(TWallRect) = -1 then
FigureClasses.Add(TWallRect);
if FigureClasses.IndexOf(TInsertCol) = -1 then
FigureClasses.Add(TInsertCol);
if FigureClasses.IndexOf(TInsertRow) = -1 then
FigureClasses.Add(TInsertRow);
end.
Reference in New Issue View Git Blame Copy Permalink