mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 22:45:39 +02:00
19967 lines
525 KiB
ObjectPascal
19967 lines
525 KiB
ObjectPascal
unit fplan;
|
|
interface
|
|
|
|
uses DrawObjects,DrawEngine,PCTypesUtils,Windows, Messages, SysUtils, 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);
|
|
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;
|
|
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;
|
|
Region: Integer;
|
|
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;
|
|
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
|
|
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;
|
|
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 WriteToStream(Stream: TStream);
|
|
Class Function CreateFromStream(Stream: TStream; xNet: Tnet; aOldPlan: Boolean): TnetPath;
|
|
Procedure Hatch(DEngine: TPCDrawEngine; isGrayed: Boolean);
|
|
Function CreateInRgn(DEngine:TPCDrawEngine): Integer;
|
|
Function CreateLinearRgn(DEngine:TPCDrawEngine): Integer;
|
|
procedure CreateLinearSubRgns(DEngine:TPCDrawEngine);
|
|
Function CreateArcRgn(DEngine:TPCDrawEngine): Integer;
|
|
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 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;
|
|
End;
|
|
|
|
|
|
|
|
TNet = class(TFigure)
|
|
Points: TList;
|
|
Paths: TList;
|
|
Structs: TList;
|
|
SelType: TNetSelType;
|
|
SelIndex: Integer;
|
|
PathRgn: Integer;
|
|
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;
|
|
NonReg: 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;
|
|
FLastTickTraceRefresh: Cardinal;
|
|
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
|
|
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;
|
|
Function InsertKnot(p:TDoublePoint;force:Boolean=false):PDoublePoint;
|
|
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: TList);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;
|
|
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): 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;
|
|
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 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 CheckContrureEntry(AOuterConture, AInnerConture: PDoublePointArr;
|
|
ACheckNoInBorder: Boolean=false; ACheckNoAdjacent: 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;
|
|
|
|
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;
|
|
|
|
{ TNet }
|
|
|
|
|
|
|
|
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
|
|
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;
|
|
|
|
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.DeletePath(Path: TnetPath):Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
result := false;
|
|
if assigned(UndoProc) then
|
|
UndoProc;
|
|
|
|
path.DoDelete; //04.06.2010
|
|
|
|
Paths.Remove(path);
|
|
CombinePathsOfKnot(path.p1);
|
|
CombinePathsOfKnot(path.p2);
|
|
RefreshPoints;
|
|
path.free;
|
|
RefreshColPositions;
|
|
RefreshPaths;
|
|
result := 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;
|
|
DeleteObject(PathRgn);
|
|
|
|
try
|
|
FSelection.Free; //27.07.2011
|
|
FRelatedNets.Clear;
|
|
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;
|
|
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
|
|
TNetPath(Paths[Index]).Hatch(Dengine,isGrayed);
|
|
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;
|
|
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]);
|
|
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;
|
|
end
|
|
else
|
|
fPaths.Add(path);
|
|
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]);
|
|
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;
|
|
end
|
|
else
|
|
fPaths.Add(path);
|
|
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
|
|
exit;
|
|
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: TList);
|
|
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);
|
|
ModList.Add(CControl.RegisterModPoint(self, ptGroupPoint, ptRect, clRed, 3, mp.x, mp.y, i));
|
|
|
|
//22.10.2010 - ìîä.ïîèíò äëÿ èçìåíåíèÿ ðàäèóñà
|
|
if path.IsArc then
|
|
begin
|
|
ModList.Add(
|
|
CControl.RegisterModPoint(self, ptArcControl, ptRect, clGreen, 3, path.ArcCenter.x, path.ArcCenter.y, i));
|
|
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) and IsPointInLine(p1, p2, path.p2^, 1)) or
|
|
(IsPointInLine(path.p1^, path.p2^, p1, 1) and IsPointInLine(path.p1^, path.p2^, p2, 1)) then
|
|
begin
|
|
if (path.Broken) then
|
|
begin
|
|
DeletePath(path);
|
|
end
|
|
else
|
|
begin
|
|
result := false;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
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 TNet.InsertKnot(p: TDoublePoint; force: Boolean = false): 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;
|
|
//22.06.2012 p1 := CheckForPoints(p);
|
|
p1 := CheckForPoints(p);
|
|
if assigned(p1) then
|
|
begin
|
|
result := p1;
|
|
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
|
|
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;
|
|
if nPt.Width <> path.Width then
|
|
begin
|
|
nPt.Width := path.Width;
|
|
RefreshPaths;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
exit;
|
|
end;
|
|
result := p1;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if force then
|
|
begin
|
|
if CheckDistance(p) then
|
|
begin
|
|
p1 := AddPoint(p);
|
|
result := p1;
|
|
end;
|
|
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;
|
|
|
|
if xPaths.Count < 2 then
|
|
exit;
|
|
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
|
|
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;}
|
|
|
|
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) 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;
|
|
TraceFigure.Free;
|
|
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);
|
|
if (Not PathsValid(path.p1)) or (Not PathsValid(path.p2)) then
|
|
begin
|
|
Path.Move(-dx,-dy);
|
|
IsMoved := false; //22.08.2011
|
|
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;
|
|
|
|
//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
|
|
DeleteObject(PathRgn);
|
|
if nonreg then
|
|
exit;
|
|
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
|
|
exit;
|
|
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;
|
|
|
|
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
|
|
exit;
|
|
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;
|
|
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;
|
|
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
|
|
pa := InsertKnot(p1, true);
|
|
pb := InsertKnot(p2, true);
|
|
if assigned(pa) and assigned(pb) then
|
|
begin
|
|
if FAllowAddPathWithSamePoints or (pa <> pb) then
|
|
begin
|
|
path := AddPath(pa, pb, false);
|
|
if assigned(path) then
|
|
begin
|
|
pCnt := pCnt + 1;
|
|
if pcnt = 1 then
|
|
result := path;
|
|
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
|
|
exit;
|
|
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;
|
|
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;
|
|
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]);
|
|
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;
|
|
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]);
|
|
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;
|
|
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
|
|
index := SelIndex - 1;
|
|
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
|
|
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): 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 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^);
|
|
Path := FirstPath;
|
|
PrevPath := nil;
|
|
PrevPt := FirstPt;
|
|
while Path <> nil do
|
|
begin
|
|
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;
|
|
|
|
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;
|
|
|
|
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;
|
|
p := FindStartConturePoint(aPaths, @NextPath, @pSide);
|
|
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;
|
|
|
|
{//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 := GetArchObjByCADObj(NextPath);
|
|
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 := GetArchObjByCADObj(NextPath);
|
|
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) 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 := GetArchObjByCADObj(NetPath);
|
|
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 := GetArchObjByCADObj(NetPath);
|
|
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;
|
|
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 := GetArchObjByCADObj(NetPath);
|
|
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;
|
|
p1 := xp1;
|
|
p2 := xp2;
|
|
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;
|
|
|
|
//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);
|
|
end;
|
|
|
|
function TnetPath.CreateArcRgn(DEngine: TPCDrawEngine): Integer;
|
|
var
|
|
pArr: TDoublePointArr;
|
|
i: Integer;
|
|
reg,reg1,reg2: Integer;
|
|
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];
|
|
end;
|
|
|
|
Stream.Read(index, 4);
|
|
if (index > -1) and (index < (xNet.Points.Count)) then
|
|
begin
|
|
Result.p2 := xNet.Points[index];
|
|
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);
|
|
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;
|
|
|
|
//GArchEngine.SetHandlersToObj(Result);
|
|
Result.AfterLoadProps;
|
|
end;
|
|
|
|
function TnetPath.CreateInRgn(DEngine: TPCDrawEngine): Integer;
|
|
begin
|
|
if not isArc then
|
|
begin
|
|
Result := CreateLinearRgn(DEngine);
|
|
CreateLinearSubRgns(DEngine);
|
|
end
|
|
else
|
|
begin
|
|
Result := CreateArcRgn(DEngine);
|
|
end;
|
|
end;
|
|
|
|
function TnetPath.CreateLinearRgn(DEngine: TPCDrawEngine): Integer;
|
|
var
|
|
{//24.03.2013
|
|
pArr:TPointArr;
|
|
i: Integer;
|
|
xx,yy,z:Double;
|
|
Points: TList;}
|
|
reg: Integer;
|
|
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: Integer;
|
|
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;
|
|
begin
|
|
ClearDoors;
|
|
Doors.Free;
|
|
DeleteObject(Region);
|
|
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);
|
|
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);
|
|
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, 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);
|
|
// =====
|
|
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
|
|
DeleteObject(Region);
|
|
Region := CreateInRgn(Dengine);
|
|
For i := 0 to Doors.Count-1 do
|
|
begin
|
|
TNetDoor(Doors[i]).UpdateRegion(Dengine);
|
|
end;
|
|
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;
|
|
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(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
|
|
p := ip;
|
|
result := True;
|
|
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;
|
|
begin
|
|
end;
|
|
|
|
procedure TnetPath.DeleteRegions;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
DeleteObject(Region);
|
|
Region := 0;
|
|
For i := 0 to Doors.Count-1 do
|
|
begin
|
|
TNetDoor(Doors[i]).DeleteRegion;
|
|
end;
|
|
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
|
|
if Assigned(FOnAfterDiv) then
|
|
FOnAfterDiv(Self);
|
|
end;
|
|
|
|
procedure TnetPath.BeforeDiv;
|
|
begin
|
|
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.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;
|
|
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;
|
|
//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);
|
|
|
|
// Ïðîâåðÿåì, âõîäèò ëè îäèí êîíòóð âî âòîðîé
|
|
if (Length(OutPoints) > 0) and (Length(InnPoints) > 0) then
|
|
begin
|
|
if CheckContrureEntry(@OutPoints, @InnPoints) 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: TNetPath;
|
|
pt1, pt2, pt: PDoublePoint;
|
|
i: Integer;
|
|
begin
|
|
if Not FDeleting then
|
|
begin
|
|
FDeleting := true;
|
|
if Assigned(FOnDelete) then
|
|
FOnDelete(Self);
|
|
end;
|
|
|
|
if (Net.Paths.Count > 3) 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;
|
|
|
|
//  ñâÿçàííûå ñåñãìåíòàõ ïåðåíîñèì òî÷êó ñ pt1 íà pt2
|
|
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;
|
|
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;
|
|
|
|
{ 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);
|
|
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: Integer;
|
|
begin
|
|
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;
|
|
SetLength(Points, Shadow.PointCount{-1});
|
|
For i := 1 to Shadow.PointCount{-1} do
|
|
// SetLength(Points,Shadow.PointCount-1);
|
|
// For i := 1 to Shadow.PointCount-1 do
|
|
begin
|
|
Points[i - 1] := Shadow.FigurePoints[i];
|
|
end;
|
|
ActiveNet.MakePathOnShadow(points); //03.06.2013 ActiveNet.MakePath(points);
|
|
end;
|
|
// *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;
|
|
|
|
function TWallPath.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean;
|
|
var
|
|
xPath: TNetPath;
|
|
Cad: TPowercad;
|
|
begin
|
|
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.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;
|
|
begin
|
|
result := false;
|
|
if PointCount = 0 then
|
|
Exit;
|
|
|
|
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;
|
|
|
|
|
|
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
|
|
FComponID := 0;
|
|
FDeleting := false;
|
|
FPath := nil;
|
|
FOnDblClick := nil;
|
|
FOnDoorChangePathQuery := nil;
|
|
FOnDelete := nil;
|
|
FOnResize := nil;
|
|
FOnSelect := nil;
|
|
FRotation := 0;
|
|
FSrcDoor := nil;
|
|
|
|
Net := xNet;
|
|
Start := s;
|
|
Width := w;
|
|
Len := l;
|
|
//Window := isWindow;
|
|
isDraw := True;
|
|
Region := 0;
|
|
DoorObjType := aDoorObjType;
|
|
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);
|
|
//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
|
|
DeleteObject(Region);
|
|
Region := 0;
|
|
end;
|
|
|
|
destructor TNetDoor.Destroy;
|
|
begin
|
|
DeleteObject(Region);
|
|
inherited;
|
|
end;
|
|
|
|
|
|
procedure TNetDoor.Draw(Dengine: TPCDrawEngine;Color:TColor);
|
|
var
|
|
Style: Integer;
|
|
DoorText: String;
|
|
p1, p2, p: TDoublePoint;
|
|
rad: 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);
|
|
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
|
|
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;
|
|
WOffSet := 700 / 50;
|
|
Window := true;
|
|
end
|
|
else
|
|
begin
|
|
Height := 2000 / 50;
|
|
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
|
|
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);
|
|
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
|
|
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);
|
|
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);
|
|
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);
|
|
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);
|
|
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);
|
|
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*
|
|
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;
|
|
|
|
|
|
|
|
function CheckContrureEntry(AOuterConture, AInnerConture: PDoublePointArr;
|
|
ACheckNoInBorder: Boolean=false; ACheckNoAdjacent: 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 IsPtInPolygon(AInnerConture^[i], AOuterConture^, false, true) then
|
|
begin
|
|
Result := false;
|
|
Break; //// BREAK ////
|
|
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 EQDP(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;
|
|
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;
|
|
i: Integer;
|
|
CrossCount: Integer;
|
|
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
|
|
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(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;
|
|
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;
|
|
while i <= WhileTo do
|
|
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;
|
|
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;
|
|
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
|
|
if CheckContrureEntry(@OutPoints, @InnPoints) 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.
|
|
|
|
|