mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 22:45:39 +02:00
14656 lines
360 KiB
ObjectPascal
14656 lines
360 KiB
ObjectPascal
unit fplan;
|
|
interface
|
|
|
|
uses DrawObjects,DrawEngine,PCTypesUtils,Windows, Messages, SysUtils, Classes,
|
|
Graphics,Dialogs,ComCtrls, Math,PCDrawing,Powercad,menus,rrEllipses, pCDrawBox;
|
|
|
|
|
|
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; // Ïîãëàùàåò ñåãìåíò
|
|
|
|
|
|
type
|
|
TNet = class;
|
|
TNetPath = class;
|
|
TNetDoor = class;
|
|
|
|
TPosType = (ptVertical, ptHorizontal, ptAngular);
|
|
TNetSelType = (stStruct, stPath);
|
|
TWallType = (wtWall, WtOpen, wtGlass, wtHalf);
|
|
TDoorType = (dtIndoor, dtOutDoor, dtMainDoor);
|
|
TDoorObjType = (dotNone, dotDoor, dotWindow, dotEmbrasure, dotNiche, dotArc, dotBalcony);
|
|
TDoorObjTypes = set of TDoorObjType;
|
|
|
|
TNotifyPathEvent = procedure(Sender: TObject; SrcPath, NewPath: TNetPath) 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;
|
|
TScaleEvent = procedure (Sender: TObject; OldScale, NewScale: Double) of object;
|
|
TPointEvent = function(Sender: TNet; APoint: PDoublePoint; AID: Integer): Integer 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;
|
|
|
|
FComponID: Integer;
|
|
FDeleting: Boolean;
|
|
FOnDblClick: TNotifyEvent;
|
|
FOnDoorChangePathQuery: TDoorChangePathQueryEvent;
|
|
FOnDelete: TNotifyEvent;
|
|
FOnResize: TNotifyEvent;
|
|
FOnSelect: TNotifyEvent;
|
|
FPath: TNetPath; // Preloaded Path Owner
|
|
|
|
FLen: Double;
|
|
|
|
procedure DefineDoorObjType;
|
|
Procedure DeleteRegion;
|
|
Procedure Draw(Dengine: TPCDrawEngine; Color: TColor);
|
|
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;
|
|
Path : TNetPath;
|
|
ShiftP: Boolean;
|
|
CtrlP: Boolean;
|
|
OPoint, p1, p2, op1, op2, xp1, xp2: TDoublePoint;
|
|
NPoints1, NPoints2: TDoublePointArr;
|
|
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;
|
|
|
|
FRelatedTraces: TList; //19.10.2010
|
|
FRelatedNets: TList; //21.10.2010
|
|
FIsRelated: Boolean; //19.10.2010
|
|
|
|
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
|
|
end;
|
|
|
|
TDoorTrace = class(TFigure)
|
|
Net: TNet;
|
|
Path, oPath: TNetPath;
|
|
Door: TnetDoor;
|
|
OPoint: TDoublePoint;
|
|
Start, NStart: Double;
|
|
|
|
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;
|
|
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;
|
|
FComponID: Integer;
|
|
FDeleting: Boolean;
|
|
FDivedFrom: TNetPath; //14.12.2010 Îò êàêîãî ñåãìåíòà ýòîò îòäåëåí
|
|
FIsInner: Boolean; //10.12.2010 Ïðèçíàê ÷òî ñåãìåíò ìåæäó äâóìÿ êîíòóðàìè
|
|
FOnAfterDiv: TNotifyEvent; //06.10.2010
|
|
FOnBeforeDiv: TNotifyEvent; //06.10.2010
|
|
FOnDblClick: TNotifyEvent;
|
|
FOnDelete: TNotifyEvent;
|
|
FOnMove: TNotifyEvent;
|
|
FOnSelect: TNotifyEvent;
|
|
FSelecting: Boolean;
|
|
|
|
el1,el2: TDoublePoint; // Temp points for offset intersections
|
|
er1,er2: TDoublePoint; // Temp points for offset intersections
|
|
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 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): 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;
|
|
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 Assign(ASource: TNetPath);
|
|
procedure AssignArcProps(APath: TNetPath);
|
|
function CmpIntersectPath(APath: TNetPath; MarginDelta:Double = 2): 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 GetConturePolygon: TDoublePointArr;
|
|
function GetDoorByComponID(AComponID: Integer): TNetDoor;
|
|
// Âåðíåò äëèíó ìóæäó òî÷êàìè, ó÷èòûâàåò åñëè äóãà
|
|
function GetLenByPoints(p1, p2: TDoublePoint): Double; //28.10.2010
|
|
// Âåðíåò òî÷êè ïî íîìåðó ñòîðîíû
|
|
function GetPointsBySide(ASideNum: Integer; var L, R, LR, RL: TDoublePoint): Boolean;
|
|
// Âåðíåò òî÷êè ñòîðîíû, êîòîðûå îïèñûâàþò òðåóãîëüíèê L, R, (LR || RL)
|
|
function GetTrianglePointsBySide(ASideNum: Integer; var L, R, T: TDoublePoint): Boolean;
|
|
// ïîëó÷èòü äëèíó âíóòðåííåé/âíåøíåé ÷àñòè
|
|
function LenByType(AType: Integer): Double; //15.10.2010
|
|
function OutLen: Double;
|
|
// Äëèíà ÷àñòè ñåãìåíòà çà èñêëþ÷åíèåì óãëîâ
|
|
function ProperLen: Double;
|
|
// Îïðåäåëÿåò òî÷êè, ïðîâåäåííûå ñ ïàðàëåëüíûõ ëèíèé
|
|
procedure PointToParralelLine;
|
|
function SecondPoint(p: PDoublePoint): PDoublePoint;
|
|
// Óñòàíîâèòü äëèíó ñåãìåíòà ïî âíóòðåííåé ÷àñòè
|
|
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;
|
|
FComponID: Integer;
|
|
FDeleting: Boolean;
|
|
FDisableMergePaths: Boolean;
|
|
FFigureModification: Boolean;
|
|
FOnAddPoint: TPointEvent; //04.10.2010
|
|
FOnAutoAddPath: TNotifyPathEvent;
|
|
FOnDelete: TNotifyEvent;
|
|
FOnDeletePoint: TPointEvent; //04.10.2010
|
|
FOnMergePaths: TMergePathsEvent; //13.01.2011
|
|
FOnMergePathsQuery: TMergePathsQueryEvent; //21.10.2010
|
|
FOnMergeNetPathsQuery: TMergeNetPathsQueryEvent;
|
|
FOnMergeNetsQuery: TMergeNetsQueryEvent; //21.10.2010
|
|
FOnResize: TNotifyEvent;
|
|
FOnScale: TScaleEvent;
|
|
FOnSelectPoint: TPointEvent; //05.10.2010
|
|
FPointIDs: TList;
|
|
|
|
FPathTracePoint: PDoublePoint; //21.10.2010 òî÷êà èç PathTrace âëàäåëüöà
|
|
FRelatedOwner: TObject; //21.10.2010
|
|
FRelatedPoints: TList;
|
|
FRelatedMPoint: PDoublePoint; //19.10.2010 - Move-point ïî êîòîðîì äàííûé Net
|
|
// (íàõîäÿùèéñÿ â ñïèñêå FRelatedNets äðóãîãî) ñâÿçàí ïî êîîðäèíàòàì ñî ñâîèì âëàäåëüöåì
|
|
FRelatedObject: TObject;
|
|
FRelatedNets: TList; //19.10.2010
|
|
|
|
FSrcNet: TNet; //21.10.2010 Îáúåêò èç êîòîðîãî ñêîïèðîâàí ýòîò
|
|
FIsGroup: Boolean;
|
|
|
|
Function SelPath: TnetPath;
|
|
Function SelDoor: TnetDoor;
|
|
Function SelWindow: TnetDoor;
|
|
Function SelCol: TnetCol;
|
|
Function SelRow: TnetRow;
|
|
Function SelCenter: TDoublePoint;
|
|
Procedure RefreshColPositions;
|
|
Function AddPoint(p: TDoublePoint): 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 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;
|
|
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 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): 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): Tnet;
|
|
Function DuplicateByPath(p:TNetPath;Group:Boolean=False): Tnet;
|
|
Procedure CollectBoundPoints(p:TNetPath; var BPoints1,BPoints2: TDoublePointArr);
|
|
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);
|
|
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);
|
|
Procedure AddDoor(aDoorObjType: TDoorObjType=dotDoor);
|
|
Procedure AddWindow;
|
|
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;
|
|
|
|
|
|
function CheckOtherNetModification: Boolean;
|
|
procedure ClearRels; //21.10.2010
|
|
function CmpIntersectPaths(p1,p2, ap1, ap2: PDoublePoint; MarginDelta:Double = 2): Integer;
|
|
procedure DeleteNet;
|
|
procedure DeletePoint(APoint: PDoublePoint); //#From Oleg# //04.10.2010
|
|
procedure DivPath(APath: TNetPath; APoint: TDoublePoint);
|
|
procedure DrawRelated(DEngine: TPCDrawEngine; isGrayed: Boolean); //19.10.2010
|
|
procedure DoClick(X, Y: Double);
|
|
procedure DoClickPoint(APoint: PDoublePoint);
|
|
procedure DoDelete;
|
|
procedure DoResize;
|
|
function FindPathInRelatedNearPoints(Ap1, Ap2: PDoublePoint): TNetPath; //19.10.2010
|
|
function GetPathByMainPoint(APoint: TDoublePoint): TNetPath;
|
|
function GetPathByNearPoints(APoint1, APoint2: PDoublePoint): TNetPath; //19.10.2010
|
|
// Âåðíåò âñå ñåãìåíòû êîòîðûå ñõîäÿòñÿ â òî÷êå
|
|
function GetPathListByPoint(APoint: PDoublePoint): TList; //05.10.2010
|
|
function GetPathListByPointID(APointID: Integer): TList; //05.10.2010
|
|
function GetPointByNear(ANearPoint: TDoublePoint): PDoublePoint;
|
|
function GetPointByID(APointID: Integer): PDoublePoint; //05.10.2010
|
|
function GetPointID(APoint: PDoublePoint): Integer; //07.10.2010
|
|
function GetPointPath(APoint: PDoublePoint): TNetPath; //21.10.2010 Âåðíåò Path êîòîðîìó ïðåíàäëåæèò Point
|
|
function IsPointInArc(p: PDoublePoint): Boolean;
|
|
procedure SetMapScale(AMapScale: Double);
|
|
procedure SetPointID(APoint: PDoublePoint; AID: Integer);
|
|
|
|
// IGOR
|
|
// ïîëó÷èòü êîíòóð êîìíàòû
|
|
function GetRoomConture: TDoublePointArr;
|
|
// ïîëó÷èòü âíóòðåííèé êîíòóð êîìíàòû
|
|
function GetRoomInnerConture: TDoublePointArr;
|
|
// ïîëó÷èòü âíåøíèé êîíòóð êîìíàòû
|
|
function GetRoomOuterConture: TDoublePointArr;
|
|
// ïîëó÷èòü êîíòóð ïîëà
|
|
function GetFloorConture: TDoublePointArr;
|
|
// ïîëó÷èòü êîíòóð ïîòîëêà
|
|
function GetCeilingConture: TDoublePointArr;
|
|
// ïîëó÷èòü ñëåä. ñòåíó ïî ìîä ïîèíòó
|
|
function GetNetPathByP1P2(aCurNetPath: TNetPath; p: TDoublePoint): TNetPath;
|
|
// íàéòè ñòàðòîâóþ òî÷êó äëÿ íàõîæäåíèÿ íåçàìêíóòîãî êîíòóðà
|
|
function FindStartConturePPoint: TDoublePoint;
|
|
|
|
// Âåðíåò ñâÿçàííûå TNet îáúåêòû ïî òî÷êå
|
|
function GetRelatedNetsByPoints(APoint1, APoint2: PDoublePoint; AllowPathCmpType: Integer=citNone): TList;
|
|
function GetRelatedPaths(APath: TNetPath; ACmpRes: TList=nil; AllowBySide: Boolean=false): TList;
|
|
function GetRelatedPoints(APoint: PDoublePoint; AOutPoints: TList=nil): TList; // Âåðíåò ñïèñîê ID òî÷åê ïî êîîðäèíàòàì
|
|
|
|
// Âåðíåò âûäåëåííóþ äâåðü/îêíî
|
|
function GetSelPathChild: TNetDoor;
|
|
function PointToOrthogonal(APoint: PDoublePoint; x, y: Double; ANet: TNet; APointMoved: Pointer=nil): TDoublePoint;
|
|
end;
|
|
|
|
function CheckContrureEntry(AOuterConture, AInnerConture: PDoublePointArr): Boolean;
|
|
procedure GetPathsConturePoints(ANetPaths: TList; AResultOuter, AResultInner: Pointer; AOutPaths, AInnPaths: TList);
|
|
function GetRelCoordType(ACoordType: Integer): Integer;
|
|
function IsPtInArray(APt: TDoublePoint; APointArray: PDoublePointArr): Boolean;
|
|
function IsPtInPolygon(APt: TDoublePoint; APollygonPaths: TDoublePointArr; APointsAsLines:Boolean=true): Boolean;
|
|
Function PointNear(p1,p2: TDoublePoint):Boolean;
|
|
|
|
type
|
|
TUndoProc = Procedure;
|
|
var
|
|
UndoProc: TUndoProc = nil;
|
|
Var
|
|
ActiveNet: Tnet;
|
|
//FFigureModification: Boolean = false;
|
|
|
|
implementation
|
|
uses U_Common, U_Cad, U_Constants, U_BaseCommon, U_ArchCommon, U_SCSComponent, U_Arch3D;
|
|
|
|
{ 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.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): 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, 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;
|
|
FComponID := 0;
|
|
FDeleting := false;
|
|
FDisableMergePaths := false;
|
|
FFigureModification := false; //#From Oleg#
|
|
FOnAddPoint := nil;
|
|
FOnAutoAddPath := nil;
|
|
FOnDelete := nil;
|
|
FOnDeletePoint := nil;
|
|
FOnMergePaths := nil;
|
|
FOnMergePathsQuery := nil; //21.10.2010
|
|
FOnMergeNetPathsQuery := nil;
|
|
FOnMergeNetsQuery := nil; //21.10.2010
|
|
FOnResize := nil;
|
|
FOnScale := 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;
|
|
i, j: integer; //19.10.2010
|
|
begin
|
|
result := nil;
|
|
FFigureModification := true; //#From Oleg#
|
|
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);
|
|
TracePoint.Tag := res.PointIndex(mp^);
|
|
Result := res;
|
|
|
|
//19.10.2010
|
|
RelNets := GetRelatedNetsByPoints(mp, nil);
|
|
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);
|
|
|
|
if RelNet.FRelatedPoints.Count > 0 then
|
|
begin
|
|
RelDupNet := RelNet.DuplicateByKnot(PDoublePoint(RelNet.FRelatedPoints[0]));
|
|
|
|
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;
|
|
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);
|
|
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);
|
|
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
|
|
MethodName := 'Destroy';
|
|
try
|
|
// Åñëè ýòî äóáëèêàò äëÿ Shadow
|
|
if (FSrcNet <> nil) and (DrawStyle = dsTrace) then
|
|
FSrcNet.FFigureModification := false;
|
|
|
|
// Î÷èùàåì ñâÿçàííûå îáúåêòû, åñëè ýòîò ÿâëÿåòñÿ âëàäåëüöåì
|
|
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
|
|
FRelatedNets.Clear;
|
|
FPointIDs.Free; //04.10.2010
|
|
FRelatedPoints.Free; //18.10.2010
|
|
FRelatedNets.Free; //19.10.2010
|
|
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,sw,sh: Integer;
|
|
path: TnetPath;
|
|
Struct: TnetStruct;
|
|
cp,xp: TDoublePOint;
|
|
rgn: HRGN;
|
|
tl,th: Double;
|
|
iStart: Integer;
|
|
xrgn: HRGN;
|
|
begin
|
|
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 := GrayedColor;
|
|
bcolor := 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
|
|
for i := iStart to paths.Count - 1 do
|
|
begin
|
|
path := TnetPath(paths[i]);
|
|
path.Tag := i;
|
|
if DrawAsTrace then
|
|
path.Style := ord(psSolid)
|
|
else
|
|
path.Style := ord(psSolid);
|
|
path.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;
|
|
if Self.FindPathInRelatedNearPoints(path.p1, path.p2) = nil then //19.10.2010 - ÷òîáû íå ïðîðèñîâàòü îäíó ëèíèþ íåñêîëüêî ðàç
|
|
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;
|
|
end;
|
|
|
|
Tnet(Res).WallThick := WallThick;
|
|
Tnet(Res).EndDraw := EndDraw;
|
|
Tnet(Res).ContextMenu := ContextMenu;
|
|
Tnet(Res).DrawGuides := DrawGuides;
|
|
Tnet(Res).EditMode := EditMode;
|
|
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): 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
|
|
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 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;
|
|
NewPath := Res.AddPath(p1,p2,true);
|
|
NewPath.FComponID := path.FComponID;
|
|
|
|
//22.10.2010
|
|
NewPath.AssignArcProps(path);
|
|
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;
|
|
|
|
Res.FComponID := FComponID; //21.10.2010
|
|
Result := res;
|
|
end;
|
|
|
|
function TNet.DuplicateByPath(p: TNetPath; Group: 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.AssignArcProps(path); //22.10.2010
|
|
end;
|
|
|
|
for i := 0 to Paths.Count - 1 do
|
|
begin
|
|
path := TNetPath(paths[i]);
|
|
if (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.AssignArcProps(path); //22.10.2010
|
|
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;
|
|
|
|
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, index: Integer;
|
|
CControl: TPCdrawing;
|
|
x, y: Double;
|
|
p: PDoublePoint;
|
|
path: TnetPath;
|
|
struct: TNetStruct;
|
|
stair: TFigure;
|
|
act: Boolean;
|
|
mp, cp: TDoublePoint;
|
|
modP: TmodPoint;
|
|
Door: TNetDoor;
|
|
begin
|
|
CControl := TPCDrawing(Owner);
|
|
path := nil;
|
|
struct := nil;
|
|
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);
|
|
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));
|
|
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;
|
|
|
|
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);
|
|
var
|
|
i: Integer;
|
|
p: TDoublePoint;
|
|
p1,p2: PDoublePoint;
|
|
xPoints: TList;
|
|
begin
|
|
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;
|
|
|
|
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.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
|
|
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;
|
|
|
|
FPointIDs := TList.Create; //04.10.2010
|
|
|
|
FPathTracePoint := nil; //21.10.2010
|
|
FRelatedOwner := nil; //21.10.2010
|
|
FRelatedPoints := TList.Create;
|
|
FRelatedNets := TList.Create;
|
|
FRelatedObject := nil;
|
|
FRelatedMPoint := nil; //19.10.2010
|
|
FSrcNet := nil; //21.10.2010
|
|
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;
|
|
|
|
Function CheckForPoints(pp: TDoublePoint): PDoublePoint;
|
|
var
|
|
xp: PDoublePoint;
|
|
k: Integer;
|
|
begin
|
|
result := nil;
|
|
for k := 0 to Points.Count - 1 do
|
|
begin
|
|
xp := PDoublePoint(Points[k]);
|
|
// if EQDP(xp^, pp) then
|
|
// begin
|
|
if GetLineLenght(xp^, pp) <= (WallThick / 2) then
|
|
begin
|
|
result := xp;
|
|
exit;
|
|
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;
|
|
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);
|
|
p2 := path.p2;
|
|
path.p2 := p1;
|
|
nPt := AddPath(p1, p2, path.border);
|
|
if Assigned(FOnAutoAddPath) then
|
|
FOnAutoAddPath(Self, path, nPt);
|
|
if nPt <> nil then
|
|
if nPt.Width <> path.Width then
|
|
begin
|
|
nPt.Width := path.Width;
|
|
RefreshPaths;
|
|
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;
|
|
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.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
|
|
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;
|
|
|
|
// ???
|
|
if GetIntersectionPoint(p1, p2, p3, p4, ip) then
|
|
begin
|
|
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;
|
|
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;
|
|
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;
|
|
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;
|
|
|
|
for i := 0 to Paths.Count - 1 do
|
|
begin
|
|
Path := TNetPath(paths[i]);
|
|
if Path.IsPointIn(x,y) then
|
|
begin
|
|
if Not FFigureModification then //#From Oleg#
|
|
begin
|
|
SelIndex := i + 1;
|
|
SelType := stPath;
|
|
//Path.TestShowPointsInfo;
|
|
end;
|
|
Result := True;
|
|
exit;
|
|
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): Boolean;
|
|
var
|
|
oldx,oldy: Double;
|
|
i: integer; //19.10.2010
|
|
RelNet: TNet; //19.10.2010
|
|
begin
|
|
Result := true; //19.10.2010
|
|
|
|
oldx := p.x;
|
|
oldy := p.y;
|
|
p.x := x;
|
|
p.y := y;
|
|
if not PathsValid(p) then
|
|
begin
|
|
p.x := oldx;
|
|
p.y := oldy;
|
|
Result := false;
|
|
end;
|
|
|
|
//19.10.2010
|
|
if Result then
|
|
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);
|
|
if Not Result then
|
|
begin
|
|
p.x := oldx;
|
|
p.y := oldy;
|
|
end;
|
|
end;
|
|
RelNet.FRelatedMPoint := nil;
|
|
end;
|
|
Self.FRelatedNets.Clear;
|
|
|
|
|
|
ResetRegion;
|
|
Modified := True;
|
|
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
|
|
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;
|
|
|
|
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);
|
|
begin
|
|
end;
|
|
|
|
procedure TNet.Move(deltax, deltay: Double);
|
|
var
|
|
i: Integer;
|
|
p: PDoublePoint;
|
|
TraceFigure: TFigure;
|
|
ShiftState: TShiftState;
|
|
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;
|
|
|
|
|
|
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
|
|
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;
|
|
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);
|
|
begin
|
|
if path <> nil then //01.10.2010
|
|
begin
|
|
Path.Move(dx,dy);
|
|
if (Not PathsValid(path.p1)) or (Not PathsValid(path.p2)) then
|
|
Path.Move(-dx,-dy);
|
|
ResetRegion;
|
|
Modified := True;
|
|
|
|
DoResize;
|
|
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;
|
|
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
|
|
result := false;
|
|
exit;
|
|
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;
|
|
var
|
|
i: Integer;
|
|
path: TNetPath;
|
|
begin
|
|
MarkBrokenPaths;
|
|
CalculatePathPoints;
|
|
IntersectPaths;
|
|
if assigned(XDrawEngine) then
|
|
UpdatePathRegion(XDrawEngine);
|
|
for i := 0 to Paths.Count - 1 do
|
|
begin
|
|
path := TnetPath(paths[i]);
|
|
path.refresh;
|
|
end;
|
|
|
|
// Remove Saved 3D Model from Stream if FPlan changed
|
|
if GSaved3DModelExist then
|
|
begin
|
|
// Remove3DModelStream;
|
|
// GSaved3DModelExist := False;
|
|
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;
|
|
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;
|
|
ResetRegion;
|
|
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;
|
|
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;
|
|
ResetRegion;
|
|
end;
|
|
|
|
function TNet.TraceModification(CadControl: Pointer; mp: TModPoint;
|
|
TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean;
|
|
var
|
|
tf: Tnet;
|
|
p: PDoublePoint;
|
|
dx, dy, delta: Double;
|
|
oPath, path: TnetPath;
|
|
pIdx: Integer;
|
|
|
|
i: integer; //19.10.2010
|
|
//Angle: Double;
|
|
RelNet: TNet;
|
|
|
|
SavedArcAng: Double;
|
|
SavedArcCenter: TDoublePoint;
|
|
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
|
|
// SnapModPoint(x, y, mp, tf);
|
|
p := PDoublePoint(tf.Points[mp.tag]);
|
|
p.x := x;
|
|
p.y := y;
|
|
if Not (ssShift in GGlobalShiftState) then //12.10.2010
|
|
p^ := PointToOrthogonal(p, x, y, tf); //12.10.2010
|
|
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;
|
|
end;
|
|
tf.CalculatePathPoints; //22.10.2010 ïåðåñ÷èòàòü äàííûå äëÿ àðîê
|
|
|
|
// 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;
|
|
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^);
|
|
tf.CalculatePathPoints;
|
|
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;
|
|
|
|
procedure TNet.AddDoor(aDoorObjType: TDoorObjType=dotDoor);
|
|
var
|
|
index, i: Integer;
|
|
path: TNetPath;
|
|
region, wLen: Double;
|
|
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]);
|
|
wLen := 15;
|
|
if path.AbsLen < 15 then
|
|
wLen := path.AbsLen * 0.9;
|
|
//Path.NewDoor(15, wLen, dotDoor);
|
|
Path.NewDoor(15, wLen, aDoorObjType);
|
|
RefreshPaths;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TNet.AddWindow;
|
|
var
|
|
index, i: Integer;
|
|
path: TNetPath;
|
|
wLen: Double;
|
|
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]);
|
|
wLen := path.AbsLen * 0.7;
|
|
if wLen > 50 then
|
|
wLen := 50;
|
|
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);
|
|
ResetRegion;
|
|
Modified := True;
|
|
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);
|
|
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;
|
|
ResetRegion;
|
|
Modified := True;
|
|
{$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);
|
|
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;
|
|
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;
|
|
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
|
|
begin
|
|
pa := InsertKnot(p1, true);
|
|
pb := InsertKnot(p2, true);
|
|
if assigned(pa) and assigned(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;
|
|
//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;
|
|
|
|
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
|
|
SelType := stPath;
|
|
SelIndex := 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
|
|
SelType := stPath;
|
|
SelIndex := 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
|
|
SelType := stPath;
|
|
SelIndex := 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;
|
|
ResetRegion;
|
|
Modified := True;
|
|
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;
|
|
ResetRegion;
|
|
Modified := True;
|
|
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;
|
|
|
|
RelNets: TList; //19.10.2010
|
|
RelNet: TNet;
|
|
RelDupNet: TNet;
|
|
i: Integer;
|
|
RelPathTrace: TPathTrace;
|
|
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);
|
|
Result := TPathTrace.Create(path, Self, (ssShift in TPowercad(owner).CurrentShift), (ssCtrl in TPowercad(owner).CurrentShift));
|
|
TPathTrace(Result).SnappedNearPoint := TPowercad(Owner).SnapToNearPoint;
|
|
TPathTrace(Result).SnappedGrid := TPowerCad(Owner).SnapToGrids;
|
|
TPathTrace(Result).SnappedGuide := TPowerCad(Owner).SnapToGuides;
|
|
|
|
Self.FRelatedNets.Clear;
|
|
|
|
//19.10.2010
|
|
if Not Path.IsArc then
|
|
begin
|
|
RelNets := GetRelatedNetsByPoints(Path.p1, Path.p2);
|
|
if RelNets <> nil then
|
|
begin
|
|
for i := 0 to RelNets.Count - 1 do
|
|
begin
|
|
RelNet := TNet(RelNets[i]);
|
|
RelNet.ClearRels;
|
|
if RelNet.FRelatedObject <> nil then
|
|
begin
|
|
if (RelNet.FRelatedObject is TNetPath) and Not TNetPath(RelNet.FRelatedObject).IsArc then
|
|
begin
|
|
//RelNet.DuplicateByPath(TNetPath(RelNet.FRelatedObject));
|
|
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;
|
|
|
|
TPathTrace(Result).FRelatedTraces.Add(RelPathTrace);
|
|
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;
|
|
Self.FRelatedNets.Add(RelNet);
|
|
|
|
RelDupNet := RelNet.DuplicateByKnot(RelNet.FRelatedMPoint);
|
|
RelDupNet.FRelatedMPoint := RelDupNet.GetPointByNear(RelNet.FRelatedMPoint^);
|
|
RelDupNet.DrawStyle := dsTrace;
|
|
RelDupNet.color := clLime;
|
|
RelDupNet.Style := 1;
|
|
RelDupNet.width := 1;
|
|
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;
|
|
|
|
RelDupNet.FRelatedOwner := Result;
|
|
TPathTrace(Result).FRelatedNets.Add(RelDupNet);
|
|
end;
|
|
end;
|
|
RelNets.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TNet.CollectBoundPoints(p: TNetPath; var BPoints1,BPoints2: TDoublePointArr);
|
|
var
|
|
i: Integer;
|
|
path: TNetPath;
|
|
begin
|
|
SetLength(BPoints1,0);
|
|
SetLength(BPoints2,0);
|
|
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
|
|
SetLength(BPoints1,Length(BPoints1)+1);
|
|
BPoints1[Length(BPoints1)-1] := path.p2^;
|
|
end
|
|
else
|
|
if (path.p2 = p.p1) then
|
|
begin
|
|
SetLength(BPoints1,Length(BPoints1)+1);
|
|
BPoints1[Length(BPoints1)-1] := path.p1^;
|
|
end
|
|
else
|
|
if (path.p1 = p.p2) then
|
|
begin
|
|
SetLength(BPoints2,Length(BPoints2)+1);
|
|
BPoints2[Length(BPoints2)-1] := path.p2^;
|
|
end
|
|
else
|
|
if (path.p2 = p.p2) then
|
|
begin
|
|
SetLength(BPoints2,Length(BPoints2)+1);
|
|
BPoints2[Length(BPoints2)-1] := path.p1^;
|
|
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;
|
|
|
|
procedure TNet.DivPath(APath: TNetPath; APoint: TDoublePoint);
|
|
var
|
|
xp1,xp2:TdoublePoint;
|
|
xp,op:PDoublePoint;
|
|
begin
|
|
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);
|
|
RefreshPaths;
|
|
finally
|
|
APath.AfterDiv; //06.10.2010
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TNet.DrawRelated(DEngine: TPCDrawEngine; isGrayed: Boolean);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FRelatedNets.Count - 1 do
|
|
TNet(FRelatedNets[i]).draw(DEngine, isGrayed);
|
|
end;
|
|
|
|
procedure TNet.DoClick(X, Y: Double);
|
|
var
|
|
Path: TNetPath;
|
|
PathChild: TNetDoor;
|
|
begin
|
|
if Not FFigureModification and Not CheckOtherNetModification then
|
|
begin
|
|
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;
|
|
|
|
procedure TNet.DoClickPoint(APoint: PDoublePoint);
|
|
var
|
|
PointIndex: Integer;
|
|
begin
|
|
if Assigned(FOnSelectPoint) then
|
|
begin
|
|
PointIndex := Points.IndexOf(APoint);
|
|
if PointIndex <> -1 then
|
|
FOnSelectPoint(Self, APoint, Integer(FPointIDs[PointIndex]));
|
|
end;
|
|
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;
|
|
TPowerCad(Owner).Figures.Remove(Self);
|
|
end;
|
|
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;
|
|
|
|
procedure TNet.ClearRels;
|
|
begin
|
|
FRelatedNets.Clear;
|
|
FRelatedOwner := nil;
|
|
FRelatedMPoint := nil;
|
|
end;
|
|
|
|
function TNet.CmpIntersectPaths(p1,p2, ap1, ap2: PDoublePoint; MarginDelta:Double = 2): Integer;
|
|
var
|
|
p1InAPath, p2InAPath: Boolean;
|
|
ap1InPath, ap2InPath: Boolean;
|
|
begin
|
|
Result := citNone;
|
|
if (PointNear(p1^, ap1^) and PointNear(p2^, ap2^)) or
|
|
(PointNear(p1^, ap2^) and PointNear(p2^, ap1^)) then
|
|
Result := citEqual
|
|
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;
|
|
|
|
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.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.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): 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^) and PointNear(APoint2^, Path.p2^)) or
|
|
(PointNear(APoint1^, Path.p2^) and PointNear(APoint2^, Path.p1^)) then
|
|
begin
|
|
Result := Path;
|
|
Break; //// BREAK ////
|
|
end;
|
|
end;
|
|
end;
|
|
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.GetPointByNear(ANearPoint: TDoublePoint): PDoublePoint;
|
|
var
|
|
i: Integer;
|
|
p: PDoublePoint;
|
|
begin
|
|
Result := nil;
|
|
for i := 0 to Points.Count - 1 do
|
|
begin
|
|
p := PDoublePoint(Points[i]);
|
|
if PointNear(ANearPoint, p^) then
|
|
begin
|
|
Result := p;
|
|
Break; //// BREAK ////
|
|
end;
|
|
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.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.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;
|
|
|
|
procedure TNet.SetMapScale(AMapScale: Double);
|
|
begin
|
|
if Assigned(FOnScale) then
|
|
FOnScale(Self, MapScale, AMapScale);
|
|
MapScale := AMapScale;
|
|
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;
|
|
|
|
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.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.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.GetFloorConture: TDoublePointArr;
|
|
var
|
|
i: integer;
|
|
p1, p2, p, 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;
|
|
p := FindStartConturePPoint;
|
|
basep := p;
|
|
|
|
wall_h1 := 0; //#From Oleg#
|
|
wall_h2 := 0;
|
|
|
|
PIndex := 0;
|
|
SetLength(Result, 0);
|
|
NextPath := nil;
|
|
while not Done do
|
|
begin
|
|
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;
|
|
p.z := wall_h1;
|
|
SetLength(Result, Length(Result) + 1);
|
|
Result[PIndex] := p;
|
|
|
|
if NextPath.isArc then
|
|
begin
|
|
SetLength(TempArr, 2);
|
|
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
|
|
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;
|
|
|
|
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
|
|
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;
|
|
p1, p2, p, 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;
|
|
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
|
|
SCSCompon := GetArchObjByCADObj(NextPath);
|
|
wall_h1 := SCSCompon.GetPropertyValueAsFloat(pnCoordZ);
|
|
wall_h2 := (wall_h1 + SCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta + FFCeilingDelta;
|
|
p.z := wall_h2;
|
|
SetLength(Result, Length(Result) + 1);
|
|
Result[PIndex] := p;
|
|
|
|
|
|
if NextPath.isArc then
|
|
begin
|
|
SetLength(TempArr, 2);
|
|
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
|
|
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;
|
|
|
|
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
|
|
p.z := 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.FindStartConturePPoint: TDoublePoint;
|
|
var
|
|
i, j, PCount: integer;
|
|
NetPath: TNetPath;
|
|
p: TDoublePoint;
|
|
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]);
|
|
if EQDP(NetPath.p1^, p) or EQDP(NetPath.p2^, p) then
|
|
begin
|
|
Wall := GetArchObjByCADObj(NetPath);
|
|
if Wall.IsLine <> ctArhWallDivision then
|
|
PCount := PCount + 1;
|
|
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.GetRelatedNetsByPoints(APoint1, APoint2: PDoublePoint; AllowPathCmpType: Integer=citNone): TList;
|
|
var
|
|
i, j, k: Integer;
|
|
Figure: TFigure;
|
|
Net: TNet;
|
|
NetPath: TNetPath;
|
|
CanMergeNets: Boolean;
|
|
|
|
p: PDoublePoint;
|
|
NetAdded: Boolean;
|
|
|
|
Path: TNetPath;
|
|
IsRelated: Boolean;
|
|
PointPaths: 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;
|
|
|
|
begin
|
|
Result := nil;
|
|
PointPaths := nil;
|
|
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
|
|
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;
|
|
end;
|
|
end;
|
|
end;
|
|
if PointPaths <> nil then
|
|
PointPaths.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): 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);
|
|
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) 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 (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;
|
|
|
|
{ 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;
|
|
door: TnetDoor;
|
|
i: Integer;
|
|
xPaths: TList;
|
|
toWall: Boolean;
|
|
begin
|
|
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;
|
|
a1 := yp1;
|
|
a2 := yp2;
|
|
OffsetPoint(p1^,ArcCenter,yp1,-ww);
|
|
OffsetPoint(p2^,ArcCenter,yp2,-ww);
|
|
r1 := yp1;
|
|
r2 := yp2;
|
|
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 := (Width / 2);
|
|
GetParallelPoints(p1^,p2^,yp1,yp2,-ww);
|
|
l1 := yp1;
|
|
l2 := yp2;
|
|
a1 := yp1;
|
|
a2 := yp2;
|
|
GetParallelPoints(p1^,p2^,yp1,yp2,ww);
|
|
r1 := yp1;
|
|
r2 := yp2;
|
|
b1 := yp1;
|
|
b2 := yp2;
|
|
ww := (Width / 2) + 1;
|
|
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;
|
|
a1 := yp1;
|
|
a2 := yp2;
|
|
GetParallelPoints(xp1,xp2,yp1,yp2,ww);
|
|
r1 := yp1;
|
|
r2 := yp2;
|
|
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;
|
|
for i := 0 to Doors.Count - 1 do
|
|
begin
|
|
Door := TnetDoor(Doors[i]);
|
|
Door.CalculatePoints(p1^,p2^);
|
|
end;
|
|
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;
|
|
Width := sPath.Width;
|
|
isArc := sPath.isArc;
|
|
ArcAng := sPath.ArcAng;
|
|
ArcRad := sPath.ArcRad;
|
|
Inverted := sPath.Inverted;
|
|
Info := sPath.Info;
|
|
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 := wtWall;
|
|
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;
|
|
FComponID := 0;
|
|
FDeleting := false;
|
|
FDivedFrom := nil; //14.12.2010
|
|
FIsInner := false;
|
|
FSelecting := false;
|
|
FOnAfterDiv := nil; //06.10.2010
|
|
FOnBeforeDiv := nil; //06.10.2010
|
|
FOnDblClick := nil;
|
|
FOnDelete := nil;
|
|
FOnMove := nil;
|
|
FOnSelect := nil;
|
|
ZeroMemory(@el1, SizeOf(TDoublePoint));
|
|
ZeroMemory(@el2, SizeOf(TDoublePoint));
|
|
ZeroMemory(@er1, SizeOf(TDoublePoint));
|
|
ZeroMemory(@er2, SizeOf(TDoublePoint));
|
|
|
|
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);
|
|
end;
|
|
|
|
Stream.Read(dCnt,4);
|
|
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;
|
|
|
|
//GArchEngine.SetHandlersToObj(Result);
|
|
end;
|
|
|
|
function TnetPath.CreateInRgn(DEngine: TPCDrawEngine): Integer;
|
|
begin
|
|
if not isArc then
|
|
begin
|
|
Result := CreateLinearRgn(DEngine);
|
|
end
|
|
else
|
|
begin
|
|
Result := CreateArcRgn(DEngine);
|
|
end;
|
|
end;
|
|
|
|
function TnetPath.CreateLinearRgn(DEngine: TPCDrawEngine): Integer;
|
|
var
|
|
pArr:TPointArr;
|
|
i: Integer;
|
|
xx,yy,z:Double;
|
|
Points: TList;
|
|
reg: Integer;
|
|
|
|
begin
|
|
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;
|
|
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);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TNetPath.Draw(Dengine: TPCDrawEngine;Color:TColor);
|
|
var
|
|
s: Integer;
|
|
mp: TDoublePOint;
|
|
begin
|
|
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;
|
|
begin
|
|
if not IsClosed then
|
|
begin
|
|
DEngine.Canvas.Pen.Mode:= pmXor;
|
|
DEngine.drawline(p1.x, p1.y, p2.x, p2.y, clLime, 1, ord(psSolid), 0);
|
|
mp := MPoint(p1^, p2^);
|
|
aLength := 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;
|
|
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;
|
|
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;
|
|
end;
|
|
// =====
|
|
Net.drawline(Dengine, xL1, l2, color, FPathWidth, FPathStyle);
|
|
Net.drawline(Dengine, xr1, r2, color, FPathWidth, FPathStyle);
|
|
// =====
|
|
end
|
|
else
|
|
begin
|
|
// =====
|
|
Net.drawline(Dengine, l1, l2, color, FPathWidth, FPathStyle);
|
|
Net.drawline(Dengine, r1, r2, color, FPathWidth, FPathStyle);
|
|
// =====
|
|
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 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);
|
|
// =====
|
|
|
|
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;
|
|
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;
|
|
DEngine.FillRgn(Region,Color,ord(bsFDiagonal));
|
|
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);
|
|
|
|
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;
|
|
|
|
//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): Boolean;
|
|
var
|
|
ipt: TPOint;
|
|
dx,dy,z: Double;
|
|
i: Integer;
|
|
Door: TnetDoor;
|
|
begin
|
|
Result := False;
|
|
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));
|
|
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;
|
|
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;
|
|
begin
|
|
result := false;
|
|
result := GetIntersectionPoint(p1^,p2^,path.p1^,path.p2^,p,false);
|
|
if not result then
|
|
begin
|
|
a1 := False;
|
|
a2 := false;
|
|
a3 := false;
|
|
a4 := false;
|
|
if isKnotIn(path.p1) = 0 then
|
|
a1:= isPointInLine(p1^,p2^,path.p1^,1);
|
|
if isKnotIn(path.p2) = 0 then
|
|
a2 := isPointInLine(p1^,p2^,path.p2^,1);
|
|
if Path.isKnotIn(p1) = 0 then
|
|
a3 := isPointInLine(path.p1^,path.p2^,p1^,1);
|
|
if Path.isKnotIn(p2) = 0 then
|
|
a4 := isPointInLine(path.p1^,path.p2^,p2^,1);
|
|
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;
|
|
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(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
|
|
p := ip;
|
|
result := True;
|
|
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.Assign(ASource: TNetPath);
|
|
begin
|
|
CopyFrom(ASource);
|
|
AssignArcProps(ASource);
|
|
end;
|
|
|
|
procedure TnetPath.AssignArcProps(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;
|
|
end;
|
|
|
|
function TnetPath.CmpIntersectPath(APath: TNetPath; MarginDelta:Double = 2): Integer;
|
|
//var
|
|
// p1InAPath, p2InAPath: Boolean;
|
|
// ap1InPath, ap2InPath: Boolean;
|
|
begin
|
|
Result := Net.CmpIntersectPaths(p1,p2, APath.p1, APath.p2, MarginDelta);
|
|
{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;
|
|
FIsInner := false;
|
|
|
|
PathList := TList.Create;
|
|
// Îïðåäåëÿåì ñïèñîê ñåãìåíòîâ òàê ÷òîáû Self áûë â ñàìîì íà÷àëå
|
|
PathList.Assign(Net.Paths);
|
|
PathList.Remove(Self);
|
|
PathList.Insert(0, Self);
|
|
|
|
GetPathsConturePoints(PathList, @OutPoints, @InnPoints, nil, nil);
|
|
//OutArea := GetAreaFromPolygon(OutPoints);
|
|
//InnArea := GetAreaFromPolygon(InnPoints);
|
|
|
|
// Ïðîâåðÿåì, âõîäèò ëè îäèí êîíòóð âî âòîðîé
|
|
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;
|
|
end
|
|
else
|
|
FIsInner := true; // ïðèçíàê ÷òî ñåãìåíò ìåæäó äâóìÿ êîíòóðàìè
|
|
|
|
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;
|
|
begin
|
|
if Not FDeleting then
|
|
begin
|
|
FDeleting := true;
|
|
if Assigned(FOnDelete) then
|
|
FOnDelete(Self);
|
|
end;
|
|
end;
|
|
|
|
Procedure TnetPath.DoClick(X, Y: Double);
|
|
var
|
|
ModPoint: TModPoint;
|
|
begin
|
|
FSelecting := true;
|
|
// Ïðîâåðêà êëèêà íà 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 EQDP(Self.p1^, DoublePoint(ModPoint.CoordX, ModPoint.CoordY)) then
|
|
TNet(Self.Net).DoClickPoint(Self.p1)
|
|
else if EQDP(Self.p2^, DoublePoint(ModPoint.CoordX, ModPoint.CoordY)) then
|
|
TNet(Self.Net).DoClickPoint(Self.p2);
|
|
end
|
|
else
|
|
begin
|
|
if Assigned(FOnSelect) then
|
|
FOnSelect(Self);
|
|
end;
|
|
FSelecting := false;
|
|
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.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.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.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;
|
|
|
|
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);
|
|
end
|
|
else
|
|
Result := GetLineLenght(p1, p2);
|
|
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.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;
|
|
|
|
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.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.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
|
|
Net.SelIndex := Index + 1;
|
|
Net.SelType := stPath;
|
|
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.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);
|
|
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;
|
|
|
|
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;
|
|
|
|
//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);
|
|
end;
|
|
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
|
|
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);
|
|
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);
|
|
begin
|
|
inherited Create(0, dsTrace, nil);
|
|
PointCount := 2;
|
|
Net := xNet;
|
|
Path := xPath;
|
|
Opath := xPath;
|
|
Door := xDoor;
|
|
Start := Door.Start;
|
|
NStart := 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;
|
|
DefineActualPoints;
|
|
|
|
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(path.p1^, path.p2^, NStart);
|
|
dp2 := MPoint(dp1, path.p2^, 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));
|
|
Dengine.drawline(path.p1^, dp1, clLime, 1, ord(psSolid), 0);
|
|
Dengine.drawline(dp2, path.p2^, 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(path.p1^, dp1){ - path.Width / 2};
|
|
l2 := GetLineLenght(path.p2^, 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(path.p1^, dp1);
|
|
p2 := MPoint(path.p2^, 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 path.p1^.y > path.p2^.y then
|
|
begin
|
|
LenTopDraw := true;
|
|
PathRotated := true;
|
|
end;
|
|
LenDelta := 2;
|
|
end
|
|
else
|
|
if Path.PosType = ptHorizontal then
|
|
begin
|
|
if path.p1^.x > path.p2^.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;
|
|
begin
|
|
if (Path <> oPath) then
|
|
begin
|
|
if Door.DoChangePathQuery(oPath, Path) then
|
|
begin
|
|
Path.Doors.Add(Door);
|
|
oPath.Doors.Remove(Door);
|
|
oPath.DoorIndex := -1;
|
|
Net.SelType := stPath;
|
|
Net.SelIndex := Net.Paths.IndexOf(Path) + 1;
|
|
end;
|
|
end;
|
|
Door.Start := NStart;
|
|
Door.Len := NLen;
|
|
Door.CalculatePoints(path.p1^, path.p2^);
|
|
Net.RefreshPaths;
|
|
Path.DoorIndex := Path.Doors.IndexOf(Door);
|
|
Door.DoResize;
|
|
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);
|
|
PointCount := 2;
|
|
Net := xNet;
|
|
Path := xPath;
|
|
Net.CollectBoundPoints(Path,NPoints1,NPoints2);
|
|
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;
|
|
end;
|
|
|
|
destructor TPathTrace.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
try
|
|
for i := 0 to FRelatedTraces.Count - 1 do
|
|
TObject(FRelatedTraces[i]).Free;
|
|
FRelatedTraces.Free;
|
|
|
|
for i := 0 to FRelatedNets.Count - 1 do
|
|
TObject(FRelatedNets[i]).Free;
|
|
FRelatedNets.Free;
|
|
|
|
Net.FFigureModification := false;
|
|
Net.ClearRels;
|
|
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;
|
|
|
|
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(AFromPoint, op: TDoublePoint; var ANPoints: TDoublePointArr); //21.10.2010
|
|
var
|
|
i: Integer;
|
|
MiddleLineDrawed: Boolean;
|
|
LineDrawLater: Boolean;
|
|
CanDrawMiddleLine: Boolean;
|
|
begin
|
|
MiddleLineDrawed := false;
|
|
if Not FIsRelated then
|
|
begin
|
|
//Dengine.drawline(AFromPoint, op,clLime,1,ord(psSolid),0);
|
|
len := (GetLineLenght(AFromPoint, 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(AFromPoint.x, ANPoints[i].x)) or (EQD(AFromPoint.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);
|
|
len := ((GetLineLenght(AFromPoint, ANPoints[i])-path.Width)*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
|
|
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(p1, op1, Npoints1); //21.10.2010
|
|
DrawNPoints(p2, op2, Npoints2); //21.10.2010
|
|
|
|
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;
|
|
|
|
procedure TPathTrace.EndTrace;
|
|
var
|
|
dx, dy, delta: Double;
|
|
repair: Boolean;
|
|
begin
|
|
dx := p1.x - path.p1^.x;
|
|
dy := p1.y - path.p1^.y;
|
|
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
|
|
}
|
|
Net.MovePath(Path,dx,dy);
|
|
|
|
EndTraceRelated; //19.10.2010
|
|
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;
|
|
|
|
// Ñòàâèì ïîèíòû ñâÿçàííûõ 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
|
|
RelNet.LocatePoint(RelNet.FRelatedMPoint, RelNet.FPathTracePoint^.x, RelNet.FPathTracePoint^.y);
|
|
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 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;
|
|
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;
|
|
|
|
OldPoint: TDoublePoint;
|
|
DeltaX, DeltaY: Double;
|
|
begin
|
|
OldPoint := p1;
|
|
|
|
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;
|
|
|
|
//22.10.2010
|
|
if isArc then
|
|
begin
|
|
DeltaX := p1.x - OldPoint.x;
|
|
DeltaY := p1.y - OldPoint.y;
|
|
|
|
ArcCenter.x := ArcCenter.x + DeltaX;
|
|
ArcCenter.y := ArcCenter.y + DeltaY;
|
|
l1.x := l1.x + DeltaX;
|
|
l1.y := l1.y + DeltaY;
|
|
l2.x := l2.x + DeltaX;
|
|
l2.y := l2.y + DeltaY;
|
|
r1.x := r1.x + DeltaX;
|
|
r1.y := r1.y + DeltaY;
|
|
r2.x := r2.x + DeltaX;
|
|
r2.y := r2.y + DeltaY;
|
|
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
|
|
RelNet.FRelatedMPoint^ := RelNet.FPathTracePoint^;
|
|
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.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): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := false;
|
|
if (Length(AOuterConture^) >= 3) and (Length(AInnerConture^) >= 3) then
|
|
begin
|
|
Result := true;
|
|
for i := 0 to Length(AInnerConture^) - 1 do
|
|
begin
|
|
if Not IsPtInPolygon(AInnerConture^[i], AOuterConture^, false) then
|
|
begin
|
|
Result := false;
|
|
Break; //// BREAK ////
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure GetPathsConturePoints(ANetPaths: TList; AResultOuter, AResultInner: Pointer; AOutPaths, AInnPaths: TList);
|
|
var
|
|
ConturePoints1: TDoublePointArr;
|
|
ContureLen1: Double;
|
|
ConturePoints2: TDoublePointArr;
|
|
ContureLen2: Double;
|
|
ConturePointsP: TDoublePointArr;
|
|
ConturePaths: TList;
|
|
ContureLenP: Double;
|
|
PCad: TPowerCad;
|
|
Area1, Area2, AreaP: Double;
|
|
|
|
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;
|
|
|
|
procedure AddPointToArray(APoint: TDoublePoint; var AArray: TDoublePointArr);
|
|
begin
|
|
SetLength(AArray, Length(AArray)+1);
|
|
AArray[Length(AArray)-1] := APoint;
|
|
end;
|
|
|
|
// òî÷êè ëåæàùèå íà ñàìîì ñåãìåíòå (äëÿ òèïà àðêà)
|
|
// ABeginPoint - íà÷àëüíàÿ òî÷êà, äîáàâëåíà ïåðåä âíóòðåííèìè
|
|
// AEndPoint - êîí÷åíàÿ òî÷êè êîòîðàÿ áóäåò äîáàâëåíà ïîñëå âíóòðåííèõ
|
|
procedure GetPathPoints(APatch: TNetPath; var AConturePoints: TDoublePointArr;
|
|
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;
|
|
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
|
|
FPointsInOrder := EQDP(ABeginPoint, DoublePoint(FPoints[0].x, FPoints[0].y));
|
|
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), AConturePoints);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetConnectedPathByCoordType(APath: TNetPath; APathList: TList; ACoordType: Integer; AConnCoordType: PInteger): TNetPath;
|
|
var
|
|
PathPoint: TDoublePoint;
|
|
i: Integer;
|
|
SPath: TNetPath;
|
|
ConnCoordType: Integer;
|
|
begin
|
|
Result := nil;
|
|
PathPoint := GetPathPointByCoordType(APath, ACoordType);
|
|
for i := 0 to APathList.Count - 1 do
|
|
begin
|
|
SPath := TNetPath(APathList[i]);
|
|
if SPath <> APath then
|
|
if APath.Connected(SPath) then
|
|
begin
|
|
ConnCoordType := -1;
|
|
if ACoordType in [crtL1, crtL2, crtR1, crtR2] then
|
|
begin
|
|
if CmpPoints(SPath.el1, PathPoint) then
|
|
ConnCoordType := crtL1
|
|
else if CmpPoints(SPath.el2, PathPoint) then
|
|
ConnCoordType := crtL2
|
|
else if CmpPoints(SPath.er1, PathPoint) then
|
|
ConnCoordType := crtR1
|
|
else if CmpPoints(SPath.er2, PathPoint) then
|
|
ConnCoordType := crtR2;
|
|
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 ConnCoordType <> -1 then
|
|
begin
|
|
Result := SPath;
|
|
if AConnCoordType <> nil then
|
|
AConnCoordType^ := ConnCoordType;
|
|
Break; //// BREAK ////
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure DefineContureFromPoint(var AConturePoints: TDoublePointArr; AStartPath: TNetPath; ACoordType: Integer);
|
|
var
|
|
NetPaths: TList;
|
|
CurrPath: TNetPath;
|
|
CurrPathCoordType: Integer;
|
|
CurrPathPoint: TDoublePoint;
|
|
CurrPathRelCoordType: Integer;
|
|
CurrPathRelPoint: TDoublePoint;
|
|
ConnPathCoordType: Integer;
|
|
begin
|
|
SetLength(AConturePoints, 0);
|
|
//DefineContureStep(AStartPath, ACoordType);
|
|
if ConturePaths <> nil then
|
|
ConturePaths.Clear;
|
|
|
|
NetPaths := TList.Create;
|
|
NetPaths.Assign(ANetPaths);
|
|
|
|
CurrPathCoordType := ACoordType;
|
|
CurrPathPoint := GetPathPointByCoordType(AStartPath, ACoordType);
|
|
CurrPath := AStartPath;
|
|
AddPointToArray(CurrPathPoint, AConturePoints);
|
|
while CurrPath <> nil do
|
|
begin
|
|
if ConturePaths <> nil then
|
|
ConturePaths.Add(CurrPath);
|
|
|
|
NetPaths.Remove(CurrPath);
|
|
// íàõîäèì âòîðóþ òî÷êó ñåãìåíòà, è äîáàâëÿåì åå â ìàññèâ
|
|
CurrPathRelCoordType := GetRelCoordType(CurrPathCoordType);
|
|
CurrPathRelPoint := GetPathPointByCoordType(CurrPath, CurrPathRelCoordType);
|
|
|
|
// Âíóòðåííèå òî÷êè
|
|
GetPathPoints(CurrPath, AConturePoints, CurrPathPoint, CurrPathRelPoint, CurrPathRelCoordType);
|
|
|
|
AddPointToArray(CurrPathRelPoint, AConturePoints);
|
|
|
|
CurrPath := GetConnectedPathByCoordType(CurrPath, NetPaths, CurrPathRelCoordType, @ConnPathCoordType);
|
|
if CurrPath <> nil then
|
|
begin
|
|
CurrPathCoordType := ConnPathCoordType; //CurrPathRelCoordType;
|
|
// Óäàëÿåì ñåãìåíò èç ñïèñêà äëÿ ïîèñêà
|
|
// AStartPath - áóäåò óäàëåí ïîñëåäíèì, åñëè êîíòóð çàìêíóòûé - ÷òîáû â êîíöå íà íåãî îïÿòü ïðèøëè
|
|
//NetPaths.Remove(CurrPath);
|
|
end;
|
|
CurrPathPoint := CurrPathRelPoint; //26.10.2010
|
|
end;
|
|
|
|
FreeAndNil(NetPaths);
|
|
end;
|
|
|
|
function IsValidConture(var AConturePoints: TDoublePointArr): Boolean;
|
|
begin
|
|
Result := false;
|
|
if Length(AConturePoints) > 2 then
|
|
if CmpPoints(AConturePoints[0], AConturePoints[length(AConturePoints)-1]) 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);
|
|
ConturePaths := nil;
|
|
|
|
if ANetPaths.Count > 0 then
|
|
begin
|
|
if Assigned(AOutPaths) or Assigned(AInnPaths) then
|
|
ConturePaths := TList.Create;
|
|
|
|
DefineContureFromPoint(ConturePoints1, 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 Assigned(AOutPaths) then
|
|
AOutPaths.Assign(ConturePaths);
|
|
if Assigned(AInnPaths) then
|
|
AInnPaths.Assign(ConturePaths);
|
|
end;
|
|
|
|
DefineContureFromPoint(ConturePoints2, 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 ConturePaths <> nil then
|
|
AOutPaths.Assign(ConturePaths);
|
|
end;
|
|
if (AResultInner <> nil) and (ContureLen2 < ContureLen1) then
|
|
begin
|
|
TDoublePointArr(AResultInner^) := ConturePoints2;
|
|
if ConturePaths <> nil then
|
|
AInnPaths.Assign(ConturePaths);
|
|
end;
|
|
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;
|
|
|
|
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 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): Boolean;
|
|
var
|
|
MaxX: Double;
|
|
VPoint: TDoublePoint;
|
|
i: Integer;
|
|
CrossCount: Integer;
|
|
begin
|
|
Result := false;
|
|
|
|
// Íàõîäèòñÿ ëè òî÷êà âíóòðè ìíîãîóãîëüíèêà, îïðåäåëÿåì ìåòîòîì ïîèñêà êîëè÷åñòâà ëèíèé
|
|
// êîòîðîå ïåðåñåêàåòñÿ ñ âèðòóàëüíîé ëèíèåé (îò òî÷êè â ïðàâî äî áåñêîíå÷íîñòè)
|
|
// åñëè êîë-âî ïåðåñå÷åíèå 0 èëè ÷åòíîå, òî íå âõîäèò, à åñëè íå÷åòíîå - òî âõîäèò
|
|
|
|
if Length(APollygonPaths) > 0 then
|
|
begin
|
|
// Îïðåäåëÿåì íàèáîëüøèé X
|
|
MaxX := APt.x;
|
|
for i := 0 to Length(APollygonPaths) - 1 do
|
|
begin
|
|
if APollygonPaths[i].x > MaxX then
|
|
MaxX := APollygonPaths[i].x;
|
|
end;
|
|
VPoint.x := MaxX + 1;
|
|
VPoint.y := APt.y;
|
|
|
|
CrossCount := 0;
|
|
i := 0;
|
|
while i <= (Length(APollygonPaths) - 2) do
|
|
begin
|
|
if LinesCross(APt, VPoint, APollygonPaths[i], APollygonPaths[i+1]) then
|
|
CrossCount := CrossCount + 1;
|
|
|
|
if APointsAsLines then
|
|
i := i+2
|
|
else
|
|
i := i+1;
|
|
end;
|
|
Result := (CrossCount <> 0) and ((CrossCount mod 2) <> 0);
|
|
end;
|
|
end;
|
|
|
|
Function PointNear(p1,p2: TDoublePoint):Boolean;
|
|
begin
|
|
result := (abs(p1.x - p2.x) <= 1) and (abs(p1.y - p2.y) <= 1);
|
|
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.
|
|
|
|
|