mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-12 00:45:40 +02:00
1348 lines
49 KiB
ObjectPascal
1348 lines
49 KiB
ObjectPascal
unit U_ProjectPlan;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Forms, StdCtrls, Classes, ComCtrls, Controls, DrawEngine, PCTypesUtils, SysUtils, Dialogs,
|
|
Contnrs, DrawObjects, PCDrawBox, PCDrawing, PowerCad, Graphics, U_Cad, U_ESCadClasess, U_SCSLists, U_SCSComponent,
|
|
U_SCSEngineTest, U_BaseCommon, U_Progress, U_Splash, Math, U_Navigator, Messages, U_Common, FastStrings;
|
|
|
|
|
|
procedure DrawProjectPlan(aList: TF_CAD; aComponTypes: TObjectList; aDivideGroupsByJoinedNetTypes, aShowGroupContents: Boolean);
|
|
Function DrawObjectsOnProjectPlan(aList: TF_CAD; aObjCatalog: TSCSCatalog; aCabBounds: TDoubleRect; aObjectX, aObjectY: Double): TPlanObject;
|
|
procedure DrawTracesOnProjectPlan(aList: TF_CAD; aPlanProject: PPlanProject; aObjList: TObjectList);
|
|
procedure DrawTraceWay(aList: TF_CAD; aPlanProject: PPlanProject; aBegObject, aEndObject: TPlanObject; aLinesNotes: TStringList; aBegObjectType, aEndObjectType: string);
|
|
|
|
function GetListBound(aList: TF_CAD): TDoubleRect;
|
|
function GetScaleNotesToBlock(aBlockBnd, aNoteBnd: TDoubleRect): Double;
|
|
function GetBlockScale(aObject: TFigureGrp; aX, aY: double): Double;
|
|
function FindPlanObject(aList: TF_CAD; aSCSID: Integer): TPlanObject;
|
|
function CheckByPlanTrace(aX, aY: Double; aTracesList: TList): TPlanTrace;
|
|
function CheckByPlanConnector(aX, aY: Double; aCurrConn1, aCurrConn2: TPlanConnector): TPlanConnector;
|
|
function CheckPlanConnectorAtPos(aSelf: TPlanConnector; aX, aY: Double): Boolean;
|
|
function CheckTypesIdentity(aCurrBegType, aCurrEndType, aSnapBegType, aSnapEndType: string): Boolean;
|
|
// àâòîïðèâÿçêè
|
|
function CheckPlanConnectorGoesToEndObject(aEndSCSID: Integer; aPlanConnector: TPlanConnector): Boolean;
|
|
function CheckPlanTraceGoesToEndObject(aEndSCSID: Integer; aPlanTrace: TPlanTrace): Boolean;
|
|
procedure SnapToPlanConnector(aConnector, aSnapConnector: TPlanConnector);
|
|
procedure SnapToPlanTrace(aConnector: TPlanConnector; aSnapTrace: TPlanTrace);
|
|
function FindSnapOnTraceTraffic(aPlanTrace: TPlanTrace; aEndObject: TPlanObject; aBegObjectType, aEndObjectType: string): Boolean;
|
|
// ñîçäàíèå ïîäïèñè ê ãðóïïå òðàññ
|
|
procedure CreatePlanTraceCaption(aPlanTrace: TPlanTrace; aCaption: TStringList);
|
|
function GetPlanTraceAngle(aPoints1, aPoints2: TDoublePoint): Double;
|
|
|
|
|
|
|
|
implementation
|
|
uses USCS_Main, Menus, U_main, U_MasterNewList, U_AutoTraceType, U_Layers, FPlan, U_SCSObjectsProp,
|
|
cxMemo, U_ChooseComponTypes, U_Constants;
|
|
|
|
|
|
procedure DrawProjectPlan(aList: TF_CAD; aComponTypes: TObjectList; aDivideGroupsByJoinedNetTypes, aShowGroupContents: Boolean);
|
|
var
|
|
i, j, k: Integer;
|
|
Bnd: TDoubleRect;
|
|
LHandle: Integer;
|
|
Rect: TRectangle;
|
|
Line: TLine;
|
|
Text: TText;
|
|
MaketX, MaketY: Double;
|
|
CurrProject: TSCSProject;
|
|
StructuredLists: TSCSLists;
|
|
ListCatalog: TSCSCatalog;
|
|
|
|
FloorDelta: Double;
|
|
CabDelta: Double;
|
|
BegPosX, BegPosY: Double;
|
|
CabBound: TDoubleRect;
|
|
ObjGroup: TPlanObject;
|
|
MaxX, MaxY: double;
|
|
ptrPlanProject: PPlanProject;
|
|
ptrPlanFloor: PPlanFloor;
|
|
ptrPlanCabinet: PPlanCabinet;
|
|
ConnectionsGroup: TCatalogGroupConnection;
|
|
ObjList: TObjectList;
|
|
|
|
NbrCircle: TCircle;
|
|
NbrText: TText;
|
|
CabCenter: TDoublePoint;
|
|
|
|
begin
|
|
try
|
|
BeginProgress;
|
|
|
|
GCadForm.Pcad.DefaultPenColor := clNavy;
|
|
GCadForm.PCad.DefaultPenWidth := 2;
|
|
GCadForm.PCad.DefaultPenStyle := psSolid;
|
|
|
|
CurrProject := F_ProjMan.GSCSBase.CurrProject;
|
|
StructuredLists := CurrProject.GetListsFilteredByComponentTypes(aComponTypes, aDivideGroupsByJoinedNetTypes, aShowGroupContents);
|
|
|
|
aList.CurrentLayer := 1;
|
|
Bnd := GetListBound(aList);
|
|
MaketX := abs(Bnd.Left - Bnd.Right);
|
|
MaketY := abs(Bnd.Bottom - Bnd.Top);
|
|
LHandle := aList.PCad.GetLayerHandle(1);
|
|
|
|
Rect := TRectangle.create(Bnd.Left, Bnd.Top, Bnd.Right, Bnd.Bottom, 1, ord(psDash), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, aList.PCad);
|
|
aList.PCad.AddCustomFigure(1, Rect, False);
|
|
|
|
FloorDelta := MaketY / StructuredLists.Count;
|
|
BegPosX := Bnd.Left;
|
|
BegPosY := Bnd.Bottom;
|
|
|
|
// Calc MaxX, MaxY
|
|
MaxY := FloorDelta;
|
|
MaxX := 0;
|
|
for i := 0 to StructuredLists.Count - 1 do
|
|
begin
|
|
if i = 0 then
|
|
// Tolik 16/11/2020 -- òóò òîæå äåëåíèå íà ÍÎËÜ èñêëþ÷àåì...
|
|
// MaxX := MaketX / StructuredLists[i].ChildCatalogs.Count
|
|
begin
|
|
if StructuredLists[i].ChildCatalogs.Count > 0 then
|
|
MaxX := MaketX / StructuredLists[i].ChildCatalogs.Count
|
|
else
|
|
MaxX := MaketX;
|
|
end
|
|
//
|
|
else
|
|
// Tolik 14/11/2020 -- òóò íóæíî èñêëþ÷èòü äåëåíèå íà ÍÎËÜ!!!
|
|
//if MaketX / StructuredLists[i].ChildCatalogs.Count < MaxX then
|
|
// MaxX := MaketX / StructuredLists[i].ChildCatalogs.Count;
|
|
begin
|
|
if StructuredLists[i].ChildCatalogs.Count > 0 then
|
|
if MaketX / StructuredLists[i].ChildCatalogs.Count < MaxX then
|
|
MaxX := MaketX / StructuredLists[i].ChildCatalogs.Count;
|
|
end;
|
|
end;
|
|
// !
|
|
New(ptrPlanProject);
|
|
ptrPlanProject.FSizeX := MaketX;
|
|
ptrPlanProject.FSizeY := MaketY;
|
|
ptrPlanProject.FBounds.Left := Bnd.Left;
|
|
ptrPlanProject.FBounds.Right := Bnd.Right;
|
|
ptrPlanProject.FBounds.Top := Bnd.Top;
|
|
ptrPlanProject.FBounds.Bottom := Bnd.Bottom;
|
|
ptrPlanProject.FFloors := TList.Create;
|
|
// !
|
|
|
|
// ÝÒÀÆÈ
|
|
for i := 0 to StructuredLists.Count - 1 do
|
|
begin
|
|
BegPosX := Bnd.Left;
|
|
BegPosY := BegPosY - FloorDelta;
|
|
// !
|
|
New(ptrPlanFloor);
|
|
ptrPlanFloor.FSizeX := MaketX;
|
|
ptrPlanFloor.FSizeY := FloorDelta;
|
|
ptrPlanFloor.FBounds.Left := BegPosX;
|
|
ptrPlanFloor.FBounds.Right := BegPosX + ptrPlanFloor.FSizeX;
|
|
ptrPlanFloor.FBounds.Top := BegPosY;
|
|
ptrPlanFloor.FBounds.Bottom := BegPosY + ptrPlanFloor.FSizeY;
|
|
ptrPlanFloor.FCabinets := TList.Create;
|
|
// !
|
|
if i < StructuredLists.Count - 1 then
|
|
begin
|
|
// ëèíèþ ðàçäåëèòåëüíóþ
|
|
Line := TLine.Create(BegPosX, BegPosY, BegPosX + MaketX, BegPosY, 1, ord(psDash), clBlack, 0, LHandle, mydsNormal, aList.PCad);
|
|
aList.PCad.AddCustomFigure(1, Line, False);
|
|
end;
|
|
// íîìåð ýòàæà
|
|
Text := TText.Create(0, 0, 14, 8, IntToStr(i + 1), aList.FFontName, RUSSIAN_CHARSET, clGray, LHandle, mydsNormal, aList.PCad);
|
|
Text.Move(BegPosX + 5 - Text.CenterPoint.x, BegPosY + FloorDelta / 2 - Text.CenterPoint.y);
|
|
aList.PCad.AddCustomFigure(1, Text, False);
|
|
Text := TText.Create(0, 0, 14, 8, IntToStr(i + 1), aList.FFontName, RUSSIAN_CHARSET, clGray, LHandle, mydsNormal, aList.PCad);
|
|
Text.Move(BegPosX + MaketX - 5 - Text.CenterPoint.x, BegPosY + FloorDelta / 2 - Text.CenterPoint.y);
|
|
aList.PCad.AddCustomFigure(1, Text, False);
|
|
|
|
if StructuredLists[i].ChildCatalogs.Count > 0 then // Tolik 14/11/2020 -- èñêëþ÷èòü äåëåíèå íà ÍÎËÜ!!!
|
|
CabDelta := MaketX / StructuredLists[i].ChildCatalogs.Count;
|
|
|
|
// ÊÀÁÈÍÅÒÛ
|
|
for j := 0 to StructuredLists[i].ChildCatalogs.Count - 1 do
|
|
begin
|
|
ListCatalog := StructuredLists[i].ChildCatalogs[j];
|
|
|
|
// !
|
|
New(ptrPlanCabinet);
|
|
ptrPlanCabinet.FSizeX := CabDelta;
|
|
ptrPlanCabinet.FSizeY := FloorDelta;
|
|
ptrPlanCabinet.FBounds.Left := BegPosX;
|
|
ptrPlanCabinet.FBounds.Right := BegPosX + ptrPlanCabinet.FSizeX;
|
|
ptrPlanCabinet.FBounds.Top := BegPosY;
|
|
ptrPlanCabinet.FBounds.Bottom := BegPosY + ptrPlanCabinet.FSizeY;
|
|
ptrPlanCabinet.FObjects := TList.Create;
|
|
// !
|
|
BegPosX := BegPosX + CabDelta;
|
|
if j < StructuredLists[i].ChildCatalogs.Count - 1 then
|
|
begin
|
|
// ëèíèþ ðàçäåëèòåëüíóþ
|
|
Line := TLine.Create(BegPosX, BegPosY, BegPosX, BegPosY + FloorDelta, 1, ord(psDash), clBlack, 0, LHandle, mydsNormal, aList.PCad);
|
|
aList.PCad.AddCustomFigure(1, Line, False);
|
|
end;
|
|
CabBound.Top := BegPosY;
|
|
CabBound.Bottom := BegPosY + FloorDelta;
|
|
CabBound.Left := BegPosX - CabDelta;
|
|
CabBound.Right := BegPosX;
|
|
// íàðèñîâàòü íîìåð êàáèíåòà
|
|
CabCenter.x := (CabBound.Right + CabBound.Left) / 2;
|
|
CabCenter.y := (CabBound.Bottom + CabBound.Top) / 2;
|
|
NbrCircle := TCircle.Create(CabCenter.x, CabCenter.y, 6, 1, ord(psDash), clMaroon, ord(bsClear), clNone, LHandle, mydsNormal, aList.PCad);
|
|
aList.PCad.AddCustomFigure(1, NbrCircle, False);
|
|
NbrText := TText.Create(CabCenter.x - 1.5, CabCenter.y - 3, 6, 3, IntToStr(ListCatalog.MarkID), aList.FFontName, RUSSIAN_CHARSET, clMaroon, LHandle, mydsNormal, aList.PCad);
|
|
aList.PCad.AddCustomFigure(1, NbrText, False);
|
|
|
|
// ÎÁÚÅÊÒÛ ÏÎ ÒÈÏÀÌ
|
|
for k := 0 to StructuredLists[i].ChildCatalogs[j].ChildCatalogs.Count - 1 do
|
|
begin
|
|
ObjGroup := DrawObjectsOnProjectPlan(aList, StructuredLists[i].ChildCatalogs[j].ChildCatalogs[k], CabBound, MaxX, MaxY);
|
|
if k = 0 then
|
|
ObjGroup.move(0, 0)
|
|
else
|
|
if k = 1 then
|
|
ObjGroup.move(CabDelta / 2, 0)
|
|
else
|
|
if k = 2 then
|
|
ObjGroup.move(0, FloorDelta / 2)
|
|
else
|
|
if k = 3 then
|
|
ObjGroup.move(CabDelta / 2, FloorDelta / 2)
|
|
else
|
|
ObjGroup.move(CabDelta / 2, FloorDelta / 2);
|
|
ObjGroup.FSCSID := StructuredLists[i].ChildCatalogs[j].ChildCatalogs[k].SCSID;
|
|
ObjGroup.FFloorNumber := i;
|
|
ObjGroup.FCabNumber := j;
|
|
ptrPlanCabinet.FObjects.Add(ObjGroup);
|
|
end;
|
|
ptrPlanFloor.FCabinets.Add(ptrPlanCabinet);
|
|
end;
|
|
ptrPlanProject.FFloors.Add(ptrPlanFloor);
|
|
end;
|
|
|
|
ObjList := TObjectList(CurrProject.GetPlanJoining(StructuredLists));
|
|
// ÏÐÎÂÅÑÒÈ ÒÐÀÑÑÛ
|
|
DrawTracesOnProjectPlan(aList, ptrPlanProject, ObjList);
|
|
|
|
// Tolik -- 09/03/2017 -- óòå÷êà ïàìÿòè -- íóæíî îñâîáîäèòü çàíÿòóþ ïàìÿòü !!!
|
|
{for i := 0 to ObjList.Count - 1 do
|
|
begin
|
|
ConnectionsGroup := TCatalogGroupConnection(ObjList[i]);
|
|
|
|
ConnectionsGroup.Free;
|
|
end;}
|
|
|
|
{
|
|
for i := (ObjList.Count - 1) downto 0 do
|
|
begin
|
|
ConnectionsGroup := TCatalogGroupConnection(ObjList[i]);
|
|
ObjList.Remove(ConnectionsGroup);
|
|
ConnectionsGroup.Free;
|
|
end; }
|
|
|
|
ObjList.Clear;
|
|
ObjList.Free; // -- îáúåêòû
|
|
|
|
// ñòðóêòóðà ïðîåêòà
|
|
for i := 0 to ptrPlanProject.FFloors.Count - 1 do
|
|
begin
|
|
ptrPlanFloor := ptrPlanProject.FFloors[i];
|
|
for j := 0 to ptrPlanFloor.FCabinets.Count - 1 do
|
|
begin
|
|
ptrPlanCabinet := ptrPlanFloor.FCabinets[j];
|
|
ptrPlanCabinet.FObjects.Clear;
|
|
FreeAndNil(ptrPlanCabinet.FObjects);
|
|
FreeMem(ptrPlanCabinet);
|
|
end;
|
|
ptrPlanFloor.FCabinets.clear;
|
|
FreeAndNil(ptrPlanFloor.FCabinets);
|
|
FreeMem(ptrPlanFloor);
|
|
end;
|
|
ptrPlanProject.FFloors.Clear;
|
|
FreeAndNil(ptrPlanProject.FFloors);
|
|
FreeMem(ptrPlanProject);
|
|
//
|
|
FreeAndNil(StructuredLists);
|
|
RefreshCAD(aList.PCad);
|
|
aList.CurrentLayer := 1;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.UpdateProjectPlan', E.Message);
|
|
end;
|
|
EndProgress;
|
|
end;
|
|
|
|
function DrawObjectsOnProjectPlan(aList: TF_CAD; aObjCatalog: TSCSCatalog; aCabBounds: TDoubleRect; aObjectX, aObjectY: Double): TPlanObject;
|
|
var
|
|
i, j, k: Integer;
|
|
Stream: TMemoryStream;
|
|
NotesList: TStringList;
|
|
GroupName: String;
|
|
GroupCount: Integer;
|
|
LHandle: Integer;
|
|
TotalFigure: TPlanObject;
|
|
Block: TBlock;
|
|
Rect: TRectangle;
|
|
BlockBnd: TDoubleRect;
|
|
BlockX, BlockY: double;
|
|
NoteBnd: TDoubleRect;
|
|
NoteX, NoteY: double;
|
|
ScaleDelta: Double;
|
|
NotesGroup: TRichText;
|
|
TM: TTextMetric;
|
|
xCanvas: TMetafileCanvas;
|
|
h, w: double;
|
|
BlockCP: TDoublePoint;
|
|
NeedCP: TDoublePoint;
|
|
begin
|
|
try
|
|
Result := nil;
|
|
LHandle := aList.PCad.GetLayerHandle(1);
|
|
Stream := aObjCatalog.GetObjectIcon(ieBlk);
|
|
GroupName := aObjCatalog.Name;
|
|
NotesList := aObjCatalog.Notes;
|
|
GroupCount := aObjCatalog.ChildCatalogs.Count;
|
|
if Stream <> nil then
|
|
begin
|
|
Block := TBlock(aList.PCad.InsertBlockFromStream(1, Stream, -100, -100));
|
|
end
|
|
else
|
|
begin
|
|
Rect := TRectangle.create(-100, -100, -100 + 18, -100 + 12, 2, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, aList.PCad);
|
|
Block := TBlock.Create(LHandle, aList.PCad);
|
|
Block.AddFigure(Rect);
|
|
aList.PCad.AddCustomFigure(1, Block, False);
|
|
end;
|
|
|
|
// ìàñøòàáèðîâàíèå ÓÎ
|
|
BlockBnd := Block.GetBoundRect;
|
|
BlockX := abs(BlockBnd.Left - BlockBnd.Right);
|
|
BlockY := abs(BlockBnd.Top - BlockBnd.Bottom);
|
|
ScaleDelta := GetBlockScale(Block, aObjectX, aObjectY);
|
|
Block.Scale(ScaleDelta, ScaleDelta);
|
|
RefreshCAD(aList.PCad);
|
|
BlockBnd := Block.GetBoundRect;
|
|
BlockX := abs(BlockBnd.Left - BlockBnd.Right);
|
|
BlockY := abs(BlockBnd.Top - BlockBnd.Bottom);
|
|
|
|
{==========================================================================}
|
|
for k := 14 downto 1 do
|
|
begin
|
|
NotesGroup := TRichText.create(-100, -100, -100, -100,
|
|
1, ord(psSolid), clBlue, ord(bsClear), clBlack, LHandle, mydsNormal, aList.PCad);
|
|
NotesGroup.re.Font.Size := k;
|
|
NotesGroup.RE.Lines.Clear;
|
|
for i := 0 to NotesList.Count - 1 do
|
|
begin
|
|
NotesList[i] := FastReplace(NotesList[i],#13#10,' ');
|
|
NotesGroup.re.Lines.Add(NotesList[i]);
|
|
end;
|
|
|
|
aList.PCad.AddCustomFigure(1, NotesGroup, False);
|
|
RefreshCAD(aList.PCad);
|
|
// ïîëó÷èòü ñâîéñòâà
|
|
|
|
// Tolik
|
|
NotesGroup.ttMetaFile:= TMetaFile.Create;
|
|
NotesGroup.ttMetafile.Enhanced := True;
|
|
|
|
xCanvas := TMetafileCanvas.Create(NotesGroup.ttMetafile, 0);
|
|
xCanvas.Font.Name := NotesGroup.re.Font.Name;
|
|
xCanvas.Font.Size := NotesGroup.re.Font.Size;
|
|
GetTextMetrics(xCanvas.Handle, TM);
|
|
h := TM.tmHeight / 4 * NotesGroup.re.Lines.Count + 1;
|
|
w := 0;
|
|
for i := 0 to NotesGroup.re.Lines.Count - 1 do
|
|
begin
|
|
if w < xCanvas.TextWidth(NotesGroup.Re.Lines[i]) then
|
|
w := xCanvas.TextWidth(NotesGroup.Re.Lines[i]);
|
|
end;
|
|
w := (w + 3) / 4 ;
|
|
FreeAndNil(xCanvas);
|
|
NotesGroup.ttMetaFile.Free;
|
|
// ïåðåñîçäàòü ñ íîâûìè ñâîéñòâàìè
|
|
if NotesGroup <> nil then
|
|
begin
|
|
aList.PCad.Figures.Remove(NotesGroup);
|
|
FreeAndNil(NotesGroup);
|
|
end;
|
|
if (k = 1) or (w < BlockX) and (h < BlockY) then
|
|
begin
|
|
NotesGroup := TRichText.create(-100, -100, -100 + w, -100 + h,
|
|
1, ord(psSolid), clBlue, ord(bsClear), clBlack, LHandle, mydsNormal, aList.PCad);
|
|
NotesGroup.re.Font.Size := k;
|
|
NotesGroup.RE.Lines.Clear;
|
|
for i := 0 to NotesList.Count - 1 do
|
|
begin
|
|
NotesList[i] := FastReplace(NotesList[i],#13#10,' ');
|
|
NotesGroup.re.Lines.Add(NotesList[i]);
|
|
end;
|
|
RefreshCAD(aList.PCad);
|
|
Break;
|
|
end;
|
|
end;
|
|
{==========================================================================}
|
|
|
|
// ïîäãîíêà ïîäïèñè ïîä ÓÎ
|
|
BlockBnd := Block.GetBoundRect;
|
|
BlockCP.x := BlockBnd.Left + BlockX / 2;
|
|
BlockCP.y := BlockBnd.Top + BlockY / 2;
|
|
NotesGroup.Move(BlockCP.x - NotesGroup.CenterPoint.x, BlockCP.y - NotesGroup.CenterPoint.y);
|
|
|
|
// â îáùèé îáúåêò
|
|
TotalFigure := TPlanObject.create(LHandle, aList.PCad);
|
|
TotalFigure.AddFigure(Block);
|
|
TotalFigure.AddFigure(NotesGroup);
|
|
Result := TPlanObject(aList.PCad.AddCustomFigure(1, TotalFigure, False));
|
|
if Block <> nil then
|
|
aList.PCad.Figures.Remove(Block);
|
|
|
|
// ñìåùåíèå Result îáúåêòà
|
|
BlockBnd := Result.GetBoundRect;
|
|
BlockX := abs(BlockBnd.Left - BlockBnd.Right);
|
|
BlockY := abs(BlockBnd.Top - BlockBnd.Bottom);
|
|
Result.FSizeX := BlockX;
|
|
Result.FSizeY := BlockY;
|
|
Result.Deselect;
|
|
Result.move(aCabBounds.Left - Result.CenterPoint.x + BlockX / 2 + 2, aCabBounds.Top - Result.CenterPoint.y + BlockY / 2 + 2);
|
|
NeedCP := GetCoordsWithSnapToGrid(Result.CenterPoint.x, Result.CenterPoint.y);
|
|
Result.move(NeedCP.x - Result.CenterPoint.x, NeedCP.y - Result.CenterPoint.y);
|
|
RefreshCAD(aList.PCad);
|
|
FreeAndNil(Stream);
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.DrawObjectsOnProjectPlan', E.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawTracesOnProjectPlan(aList: TF_CAD; aPlanProject: PPlanProject; aObjList: TObjectList);
|
|
var
|
|
i: integer;
|
|
aConnectionsGroup: TCatalogGroupConnection;
|
|
BegCatalog: TSCSCatalog;
|
|
EndCatalog: TSCSCatalog;
|
|
Lines: TSCSCatalogs;
|
|
BegObject: TPlanObject;
|
|
EndObject: TPlanObject;
|
|
LinesNotes: TStringList;
|
|
BegObjectType, EndObjectType: string;
|
|
begin
|
|
try
|
|
for i := 0 to aObjList.Count - 1 do
|
|
begin
|
|
aConnectionsGroup := TCatalogGroupConnection(aObjList[i]);
|
|
BegCatalog := aConnectionsGroup.BeginCatalogGroup;
|
|
EndCatalog := aConnectionsGroup.EndCatalogGroup;
|
|
LinesNotes := aConnectionsGroup.LinesNote;
|
|
BegObject := FindPlanObject(aList, BegCatalog.SCSID);
|
|
EndObject := FindPlanObject(aList, EndCatalog.SCSID);
|
|
BegObjectType := BegCatalog.GUIDComponentType;
|
|
EndObjectType := EndCatalog.GUIDComponentType;
|
|
if (BegObject <> nil) and (EndObject <> nil) then
|
|
DrawTraceWay(aList, aPlanProject, BegObject, EndObject, LinesNotes, BegObjectType, EndObjectType);
|
|
end;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.DrawTracesOnProjectPlan', E.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawTraceWay(aList: TF_CAD; aPlanProject: PPlanProject; aBegObject, aEndObject: TPlanObject; aLinesNotes: TStringList; aBegObjectType, aEndObjectType: string);
|
|
var
|
|
i, j, k: Integer;
|
|
x1, x2, y1, y2: Double;
|
|
PlanTrace1, PlanTrace2, PlanTrace3: TPlanTrace;
|
|
Conn1, Conn2, Conn3, Conn4: TPlanConnector;
|
|
LHandle: Integer;
|
|
CabBounds: TDoubleRect;
|
|
CabPosX: Double;
|
|
deltato: Double;
|
|
|
|
begin
|
|
try
|
|
CabBounds := PPlanCabinet(PPlanFloor(aPlanProject.FFloors[aBegObject.FFloorNumber]).FCabinets[aBegObject.FCabNumber]).FBounds;
|
|
CabPosX := abs(CabBounds.Right - CabBounds.Left) / 2;
|
|
CabPosX := CabPosX + abs(CabBounds.Right - CabBounds.Left) * aBegObject.FCabNumber + aPlanProject.FBounds.Left;
|
|
LHandle := aList.PCad.GetLayerHandle(1);
|
|
|
|
// Correct BeginEnd Objects Pos
|
|
if aBegObject.FFloorNumber = aEndObject.FFloorNumber then
|
|
if abs(aBegObject.CenterPoint.y - aEndObject.CenterPoint.y) < 1 then
|
|
aBegObject.move(0, 1);
|
|
|
|
// íà÷èíàòü âïðàâî
|
|
if aBegObject.CenterPoint.x < CabPosX then
|
|
begin
|
|
x1 := aBegObject.CenterPoint.x + aBegObject.FSizeX / 2;
|
|
y1 := aBegObject.CenterPoint.y;
|
|
|
|
x2 := CabPosX;
|
|
y2 := y1;
|
|
if abs(x1 - x2) < 5 then
|
|
begin
|
|
if x1 < x2 then
|
|
x2 := x1 + 5
|
|
else
|
|
x2 := x1 - 5;
|
|
end;
|
|
end
|
|
else
|
|
// âëåâî
|
|
begin
|
|
x1 := aBegObject.CenterPoint.x - aBegObject.FSizeX / 2;
|
|
y1 := aBegObject.CenterPoint.y;
|
|
|
|
x2 := CabPosX;
|
|
y2 := y1;
|
|
if abs(x1 - x2) < 5 then
|
|
begin
|
|
if x1 < x2 then
|
|
x2 := x1 + 5
|
|
else
|
|
x2 := x1 - 5;
|
|
end;
|
|
end;
|
|
x1 := GetCoordXWithSnapToGrid(x1);
|
|
y1 := GetCoordXWithSnapToGrid(y1);
|
|
x2 := GetCoordXWithSnapToGrid(x2);
|
|
y2 := GetCoordXWithSnapToGrid(y2);
|
|
|
|
|
|
// Connector1
|
|
Conn1 := TPlanConnector.Create(x1, y1, 0, LHandle, mydsNormal, aList.PCad);
|
|
Conn1.FBegSCSID := aBegObject.FSCSID;
|
|
Conn1.FEndSCSID := aEndObject.FSCSID;
|
|
Conn1.FBegType := aBegObjectType;
|
|
Conn1.FEndType := aEndObjectType;
|
|
Conn1.ConnectorType := ct_Clear;
|
|
aList.PCad.AddCustomFigure (1, Conn1, False);
|
|
// DELETE FROM PM
|
|
// if Conn1.Selected then
|
|
// Conn1.Deselect;
|
|
// DeleteObjectFromPM(Conn1.ID, Conn1.Name);
|
|
|
|
aBegObject.JoinedConnectors.Add(Conn1);
|
|
Conn1.JoinedPlanObject := aBegObject;
|
|
Conn1.LockSelect := True;
|
|
Conn1.LockModify := True;
|
|
|
|
// Trace1
|
|
PlanTrace1 := TPlanTrace.create(x1, y1, x2, y2, 2, ord(psSolid), clNavy, 0, LHandle, mydsNormal, aList.PCad);
|
|
PlanTrace1.FBegSCSID := aBegObject.FSCSID;
|
|
PlanTrace1.FEndSCSID := aEndObject.FSCSID;
|
|
PlanTrace1.FBegType := aBegObjectType;
|
|
PlanTrace1.FEndType := aEndObjectType;
|
|
aList.PCad.AddCustomFigure(1, PlanTrace1, False);
|
|
// Connector2
|
|
Conn2 := TPlanConnector.Create(x2, y2, 0, LHandle, mydsNormal, aList.PCad);
|
|
Conn2.FBegSCSID := aBegObject.FSCSID;
|
|
Conn2.FEndSCSID := aEndObject.FSCSID;
|
|
Conn2.FBegType := aBegObjectType;
|
|
Conn2.FEndType := aEndObjectType;
|
|
Conn2.ConnectorType := ct_Clear;
|
|
aList.PCad.AddCustomFigure (1, Conn2, False);
|
|
// DELETE FROM PM
|
|
// if Conn2.Selected then
|
|
// Conn2.Deselect;
|
|
// DeleteObjectFromPM(Conn2.ID, Conn1.Name);
|
|
|
|
PlanTrace1.SetJConnector1(Conn1);
|
|
SetConnBringToFront(Conn1);
|
|
PlanTrace1.SetJConnector2(Conn2);
|
|
CreatePlanTraceCaption(PlanTrace1, aLinesNotes);
|
|
// FindSnapLine
|
|
if aBegObjectType <> aEndObjectType then
|
|
begin
|
|
if FindSnapOnTraceTraffic(PlanTrace1, aEndObject, aBegObjectType, aEndObjectType) then
|
|
Exit;
|
|
end;
|
|
// åñëè â òî÷êå íà÷àëà - ñïóñòèòü íà 1
|
|
while CheckPlanConnectorAtPos(Conn1, Conn1.ActualPoints[1].x, Conn1.ActualPoints[1].y) do
|
|
begin
|
|
if Conn1 <> nil then
|
|
Conn1.move(0, 3);
|
|
if Conn2 <> nil then
|
|
Conn2.move(0, 3);
|
|
// PlanTrace1.Move(0, 3);
|
|
end;
|
|
|
|
// Trace2
|
|
x1 := Conn2.ActualPoints[1].x;
|
|
y1 := Conn2.ActualPoints[1].y;
|
|
x2 := x1;
|
|
y2 := aEndObject.CenterPoint.y;
|
|
x2 := GetCoordXWithSnapToGrid(x2);
|
|
y2 := GetCoordXWithSnapToGrid(y2);
|
|
if abs(y1 - y2) < 1 then
|
|
y2 := y1 + 1;
|
|
|
|
PlanTrace2 := TPlanTrace.create(x1, y1, x2, y2, 2, ord(psSolid), clNavy, 0, LHandle, mydsNormal, aList.PCad);
|
|
PlanTrace2.FBegSCSID := aBegObject.FSCSID;
|
|
PlanTrace2.FEndSCSID := aEndObject.FSCSID;
|
|
PlanTrace2.FBegType := aBegObjectType;
|
|
PlanTrace2.FEndType := aEndObjectType;
|
|
aList.PCad.AddCustomFigure (1, PlanTrace2, False);
|
|
// Connector3
|
|
Conn3 := TPlanConnector.Create(x2, y2, 0, LHandle, mydsNormal, aList.PCad);
|
|
Conn3.FBegSCSID := aBegObject.FSCSID;
|
|
Conn3.FEndSCSID := aEndObject.FSCSID;
|
|
Conn3.FBegType := aBegObjectType;
|
|
Conn3.FEndType := aEndObjectType;
|
|
Conn3.ConnectorType := ct_Clear;
|
|
aList.PCad.AddCustomFigure (1, Conn3, False);
|
|
// DELETE FROM PM
|
|
// if Conn3.Selected then
|
|
// Conn3.Deselect;
|
|
// DeleteObjectFromPM(Conn3.ID, Conn1.Name);
|
|
|
|
PlanTrace2.SetJConnector1(Conn2);
|
|
SetConnBringToFront(Conn2);
|
|
PlanTrace2.SetJConnector2(Conn3);
|
|
// LineCorrect
|
|
if (aEndObject.IsPointIn(Conn2.ActualPoints[1].x, Conn2.ActualPoints[1].y)) or (aEndObject.IsPointIn(Conn3.ActualPoints[1].x, Conn3.ActualPoints[1].y)) then
|
|
begin
|
|
if PlanTrace1.ActualPoints[1].x < PlanTrace1.ActualPoints[2].x then
|
|
begin
|
|
deltato := aEndObject.CenterPoint.x + aEndObject.FSizeX / 2 + 5;
|
|
deltato := GetCoordXWithSnapToGrid(deltato);
|
|
PlanTrace2.Move(deltato - Conn3.ActualPoints[1].x, 0);
|
|
end
|
|
else
|
|
begin
|
|
deltato := aEndObject.CenterPoint.x - aEndObject.FSizeX / 2 + 5;
|
|
deltato := GetCoordXWithSnapToGrid(deltato);
|
|
PlanTrace2.Move(deltato - Conn3.ActualPoints[1].x, 0);
|
|
end;
|
|
end;
|
|
// FindSnapLine
|
|
if aBegObjectType <> aEndObjectType then
|
|
begin
|
|
if FindSnapOnTraceTraffic(PlanTrace2, aEndObject, aBegObjectType, aEndObjectType) then
|
|
Exit;
|
|
end;
|
|
|
|
// Trace3
|
|
CabPosX := Conn3.ActualPoints[1].x;
|
|
// íàëåâî
|
|
if aEndObject.CenterPoint.x < CabPosX then
|
|
begin
|
|
x1 := Conn3.ActualPoints[1].x;
|
|
y1 := Conn3.ActualPoints[1].y;
|
|
x2 := aEndObject.CenterPoint.x + aEndObject.FSizeX / 2;
|
|
y2 := y1;
|
|
end
|
|
else
|
|
// íàïðàâî
|
|
begin
|
|
x1 := Conn3.ActualPoints[1].x;
|
|
y1 := Conn3.ActualPoints[1].y;
|
|
x2 := aEndObject.CenterPoint.x - aEndObject.FSizeX / 2;
|
|
y2 := y1;
|
|
end;
|
|
PlanTrace3 := TPlanTrace.create(x1, y1, x2, y2, 2, ord(psSolid), clNavy, 0, LHandle, mydsNormal, aList.PCad);
|
|
PlanTrace3.FBegSCSID := aBegObject.FSCSID;
|
|
PlanTrace3.FEndSCSID := aEndObject.FSCSID;
|
|
PlanTrace3.FBegType := aBegObjectType;
|
|
PlanTrace3.FEndType := aEndObjectType;
|
|
aList.PCad.AddCustomFigure (1, PlanTrace3, False);
|
|
// Connector4
|
|
Conn4 := TPlanConnector.Create(x2, y2, 0, LHandle, mydsNormal, aList.PCad);
|
|
Conn4.FBegSCSID := aBegObject.FSCSID;
|
|
Conn4.FEndSCSID := aEndObject.FSCSID;
|
|
Conn4.FBegType := aBegObjectType;
|
|
Conn4.FEndType := aEndObjectType;
|
|
Conn4.ConnectorType := ct_Clear;
|
|
aList.PCad.AddCustomFigure (1, Conn4, False);
|
|
// DELETE FROM PM
|
|
// if Conn4.Selected then
|
|
// Conn4.Deselect;
|
|
// DeleteObjectFromPM(Conn4.ID, Conn4.Name);
|
|
|
|
PlanTrace3.SetJConnector1(Conn3);
|
|
SetConnBringToFront(Conn3);
|
|
PlanTrace3.SetJConnector2(Conn4);
|
|
SetConnBringToFront(Conn4);
|
|
// LineCorrect
|
|
if aBegObjectType <> aEndObjectType then
|
|
begin
|
|
if FindSnapOnTraceTraffic(PlanTrace3, aEndObject, aBegObjectType, aEndObjectType) then
|
|
Exit;
|
|
end;
|
|
// åñëè â òî÷êå êîíöà òðàññû - ñïóñòèòü íà 1
|
|
while CheckPlanConnectorAtPos(Conn4, Conn4.ActualPoints[1].x, Conn4.ActualPoints[1].y) do
|
|
begin
|
|
if Conn3 <> nil then
|
|
Conn3.move(0, 3);
|
|
if Conn4 <> nil then
|
|
Conn4.move(0, 3);
|
|
// PlanTrace3.Move(0, 3);
|
|
end;
|
|
|
|
aEndObject.JoinedConnectors.Add(Conn4);
|
|
Conn4.JoinedPlanObject := aEndObject;
|
|
Conn4.LockSelect := True;
|
|
Conn4.LockModify := True;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.DrawTraceWay', E.Message);
|
|
end;
|
|
end;
|
|
|
|
function FindPlanObject(aList: TF_CAD; aSCSID: Integer): TPlanObject;
|
|
var
|
|
i: integer;
|
|
begin
|
|
try
|
|
Result := nil;
|
|
for i := 0 to aList.PCad.FigureCount - 1 do
|
|
begin
|
|
if CheckFigureByClassName(TFigure(aList.PCad.Figures[i]), cTPlanObject) then
|
|
begin
|
|
if TPlanObject(aList.PCad.Figures[i]).FSCSID = aSCSID then
|
|
Result := TPlanObject(aList.PCad.Figures[i]);
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.FindPlanObject', E.Message);
|
|
end;
|
|
end;
|
|
|
|
function GetListBound(aList: TF_CAD): TDoubleRect;
|
|
var
|
|
ListWidth, Listheight: double;
|
|
ListBottomParam: double;
|
|
step: double;
|
|
LeftBound, RightBound, TopBound, BottomBound: double;
|
|
begin
|
|
try
|
|
Result := DoubleRect(0, 0, 0, 0);
|
|
ListWidth := AList.PCad.WorkWidth;
|
|
ListHeight := AList.PCad.WorkHeight;
|
|
if AList.FCadStampType = stt_simple then
|
|
ListBottomParam := 15
|
|
else
|
|
if AList.FCadStampType = stt_extended then
|
|
ListBottomParam := 40
|
|
else
|
|
if AList.FCadStampType = stt_detailed then
|
|
ListBottomParam := 55;
|
|
step := aList.PCad.GridStep;
|
|
|
|
TopBound := 25;
|
|
LeftBound := 30;
|
|
RightBound := aList.PCad.WorkWidth - 15;
|
|
BottomBound := aList.PCad.WorkHeight - 20 - ListBottomParam;
|
|
|
|
Result.Top := GetCoordYWithSnapToGrid(TopBound);
|
|
Result.Left := GetCoordXWithSnapToGrid(LeftBound);
|
|
Result.Right := GetCoordYWithSnapToGrid(RightBound);
|
|
Result.Bottom := GetCoordYWithSnapToGrid(BottomBound);
|
|
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.GetListBound', E.Message);
|
|
end;
|
|
end;
|
|
|
|
function GetBlockScale(aObject: TFigureGrp; aX, aY: double): Double;
|
|
var
|
|
BlockBnd: TDoubleRect;
|
|
BlockX, BlockY: double;
|
|
CabX, CabY: Double;
|
|
px, py: double;
|
|
begin
|
|
try
|
|
Result := 0;
|
|
BlockBnd := aObject.GetBoundRect;
|
|
BlockX := abs(BlockBnd.Left - BlockBnd.Right);
|
|
BlockY := abs(BlockBnd.Top - BlockBnd.Bottom);
|
|
CabX := aX;
|
|
CabY := aY;
|
|
px := (CabX - 6) / BlockX / 2;
|
|
py := (CabY - 6) / BlockY / 2;
|
|
if px < py then
|
|
Result := px
|
|
else
|
|
Result := py;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.GetBlockScale', E.Message);
|
|
end;
|
|
end;
|
|
|
|
function GetScaleNotesToBlock(aBlockBnd, aNoteBnd: TDoubleRect): Double;
|
|
var
|
|
BlockX, BlockY: double;
|
|
NoteX, NoteY: double;
|
|
LimitNoteX, LimitNoteY: double;
|
|
KoefScaleX, KoefScaleY: double;
|
|
begin
|
|
try
|
|
Result := 0;
|
|
BlockX := abs(aBlockBnd.Left - aBlockBnd.Right);
|
|
BlockY := abs(aBlockBnd.Top - aBlockBnd.Bottom);
|
|
NoteX := abs(aNoteBnd.Left - aNoteBnd.Right);
|
|
NoteY := abs(aNoteBnd.Top - aNoteBnd.Bottom);
|
|
LimitNoteX := BlockX - 2;
|
|
LimitNoteY := BlockY - 2;
|
|
KoefScaleX := LimitNoteX / NoteX;
|
|
KoefScaleY := LimitNoteY / NoteY;
|
|
if KoefScaleX < KoefScaleY then
|
|
Result := KoefScaleX
|
|
else
|
|
Result := KoefScaleY;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.ScaleNotesToBlock', E.Message);
|
|
end;
|
|
end;
|
|
|
|
function CheckByPlanTrace(aX, aY: Double; aTracesList: TList): TPlanTrace;
|
|
var
|
|
i: integer;
|
|
CurFigure: TFigure;
|
|
begin
|
|
try
|
|
Result := nil;
|
|
for i := 0 to GCadForm.PCad.FigureCount - 1 do
|
|
begin
|
|
CurFigure := TFigure(GCadForm.PCad.Figures[i]);
|
|
if CheckFigureByClassName(CurFigure, cTPlanTrace) then
|
|
begin
|
|
if CheckNoFigureInList(CurFigure, aTracesList) then
|
|
if TPlanTrace(CurFigure).IsPointIn(aX, aY) then
|
|
Result := TPlanTrace(CurFigure);
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CheckByPlanTrace', E.Message);
|
|
end;
|
|
end;
|
|
|
|
function CheckByPlanConnector(aX, aY: Double; aCurrConn1, aCurrConn2: TPlanConnector): TPlanConnector;
|
|
var
|
|
i: integer;
|
|
CurFigure: TFigure;
|
|
begin
|
|
try
|
|
Result := nil;
|
|
for i := 0 to GCadForm.PCad.FigureCount - 1 do
|
|
begin
|
|
CurFigure := TFigure(GCadForm.PCad.Figures[i]);
|
|
if CheckFigureByClassName(CurFigure, cTPlanConnector) then
|
|
begin
|
|
if TPlanConnector(CurFigure).IsPointIn(aX, aY) then
|
|
if (aCurrConn1 <> TPlanConnector(CurFigure)) and (aCurrConn2 <> TPlanConnector(CurFigure)) then
|
|
if TPlanConnector(CurFigure).JoinedPlanObject = nil then
|
|
Result := TPlanConnector(CurFigure);
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CheckByPlanConnector', E.Message);
|
|
end;
|
|
end;
|
|
|
|
function CheckPlanConnectorAtPos(aSelf: TPlanConnector; aX, aY: Double): Boolean;
|
|
var
|
|
i: Integer;
|
|
CurFigure: TFigure;
|
|
begin
|
|
try
|
|
Result := false;
|
|
for i := 0 to GCadForm.PCad.FigureCount - 1 do
|
|
begin
|
|
CurFigure := TFigure(GCadForm.PCad.Figures[i]);
|
|
if CheckFigureByClassName(CurFigure, cTPlanConnector) then
|
|
begin
|
|
if TPlanConnector(CurFigure) <> aSelf then
|
|
if TPlanConnector(CurFigure).IsPointIn(aX, aY) then
|
|
if TPlanConnector(CurFigure).JoinedPlanObject <> nil then
|
|
Result := True;
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CheckPlanConnectorAtPos', E.Message);
|
|
end;
|
|
end;
|
|
|
|
function CheckTypesIdentity(aCurrBegType, aCurrEndType, aSnapBegType, aSnapEndType: string): Boolean;
|
|
begin
|
|
try
|
|
Result := false;
|
|
if ((aCurrBegType = aSnapBegType) and (aCurrEndType = aSnapEndType)) or
|
|
((aCurrBegType = aSnapEndType) and (aCurrEndType = aSnapBegType)) then
|
|
Result := True;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CheckTypesIdentity', E.Message);
|
|
end;
|
|
end;
|
|
|
|
function CheckPlanConnectorGoesToEndObject(aEndSCSID: Integer; aPlanConnector: TPlanConnector): Boolean;
|
|
var
|
|
i: integer;
|
|
CurTrace: TPlanTrace;
|
|
begin
|
|
try
|
|
Result := false;
|
|
if aEndSCSID = aPlanConnector.FEndSCSID then
|
|
Result := true
|
|
else
|
|
Result := false;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CheckPlanConnectorGoesToEndObject', E.Message);
|
|
end;
|
|
end;
|
|
|
|
function CheckPlanTraceGoesToEndObject(aEndSCSID: Integer; aPlanTrace: TPlanTrace): Boolean;
|
|
begin
|
|
try
|
|
Result := false;
|
|
if aEndSCSID = aPlanTrace.FEndSCSID then
|
|
Result := true
|
|
else
|
|
Result := false;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CheckPlanTraceGoesToEndObject', E.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure SnapToPlanConnector(aConnector, aSnapConnector: TPlanConnector);
|
|
var
|
|
i, j: integer;
|
|
NewDeltaX, NewDeltaY: double;
|
|
OLine: TPlanTrace;
|
|
|
|
begin
|
|
try
|
|
aConnector.Name := aSnapConnector.Name;
|
|
// âû÷èñëåíèå ðàçíèöû â êîîðäèíàòàõ äëÿ ñîåäèíåíèÿ îáüåêòîâ
|
|
NewDeltaX := ASnapConnector.ActualPoints[1].x - AConnector.ActualPoints[1].x;
|
|
NewDeltaY := ASnapConnector.ActualPoints[1].y - AConnector.ActualPoints[1].y;
|
|
AConnector.ActualPoints[1] := DoublePoint(ASnapConnector.ActualPoints[1].x, ASnapConnector.ActualPoints[1].y);
|
|
|
|
for i := 0 to AConnector.JoinedTraces.Count - 1 do
|
|
begin
|
|
if AConnector = TPlanTrace(AConnector.JoinedTraces[i]).JoinObject1 then
|
|
begin
|
|
TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[1] := DoublePoint(
|
|
TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[1].x + NewDeltaX,
|
|
TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[1].y + NewDeltaY);
|
|
end;
|
|
if AConnector = TPlanTrace(AConnector.JoinedTraces[i]).JoinObject2 then
|
|
begin
|
|
TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[2] := DoublePoint(
|
|
TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[2].x + NewDeltaX,
|
|
TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[2].y + NewDeltaY);
|
|
end;
|
|
end;
|
|
|
|
for i := 0 to ASnapConnector.JoinedTraces.Count - 1 do
|
|
begin
|
|
OLine := TPlanTrace(ASnapConnector.JoinedTraces[i]);
|
|
if OLine.JoinObject1 = ASnapConnector then
|
|
begin
|
|
OLine.SetJConnector1(AConnector);
|
|
end;
|
|
if OLine.JoinObject2 = ASnapConnector then
|
|
begin
|
|
OLine.SetJConnector2(AConnector);
|
|
end;
|
|
end;
|
|
aSnapConnector.JoinedTraces.Clear;
|
|
aSnapConnector.Delete;
|
|
RefreshCAD(GCadForm.PCad);
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.SnapToPlanConnector', E.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure SnapToPlanTrace(aConnector: TPlanConnector; aSnapTrace: TPlanTrace);
|
|
var
|
|
i, j: integer;
|
|
NewDeltaX, NewDeltaY: double;
|
|
AddLine: TPlanTrace;
|
|
NextConnector: TFigure;
|
|
Modx, Mody, NextModx, NextMody: Double;
|
|
DeltaHeight: Double;
|
|
JoinedConn: TPlanConnector;
|
|
|
|
begin
|
|
try
|
|
NextConnector := aSnapTrace.JoinObject2;
|
|
if aSnapTrace.ActualPoints[1].x = aSnapTrace.ActualPoints[2].x then
|
|
begin
|
|
NewDeltaY := 0;
|
|
NewDeltaX := aSnapTrace.ActualPoints[1].x - AConnector.ActualPoints[1].x;
|
|
AConnector.ActualPoints[1] := DoublePoint(AConnector.ActualPoints[1].x + NewDeltaX, AConnector.ActualPoints[1].y);
|
|
end
|
|
else
|
|
if aSnapTrace.ActualPoints[1].y = aSnapTrace.ActualPoints[2].y then
|
|
begin
|
|
NewDeltaX := 0;
|
|
NewDeltaY := aSnapTrace.ActualPoints[1].y - AConnector.ActualPoints[1].y;
|
|
AConnector.ActualPoints[1] := DoublePoint(AConnector.ActualPoints[1].x, AConnector.ActualPoints[1].y + NewDeltaY);
|
|
end
|
|
else
|
|
begin
|
|
NewDeltaX := 0;
|
|
NewDeltaY := 0;
|
|
AConnector.ActualPoints[1] := DoublePoint(AConnector.ActualPoints[1].x + NewDeltaX, AConnector.ActualPoints[1].y + NewDeltaY);
|
|
end;
|
|
|
|
for i := 0 to AConnector.JoinedTraces.Count - 1 do
|
|
begin
|
|
if AConnector = TPlanTrace(AConnector.JoinedTraces[i]).JoinObject1 then
|
|
begin
|
|
TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[1] := DoublePoint(
|
|
TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[1].x + NewDeltaX,
|
|
TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[1].y + NewDeltaY);
|
|
end;
|
|
if AConnector = TPlanTrace(AConnector.JoinedTraces[i]).JoinObject2 then
|
|
begin
|
|
TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[2] := DoublePoint(
|
|
TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[2].x + NewDeltaX,
|
|
TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[2].y + NewDeltaY);
|
|
end;
|
|
end;
|
|
// âû÷èñëåíèå òî÷åê ìîäèôèêàöèè
|
|
Modx := (AConnector.ActualPoints[1].x + AConnector.ActualPoints[2].x) / 2;
|
|
Mody := (AConnector.ActualPoints[1].y + AConnector.ActualPoints[2].y) / 2;
|
|
NextModx := (NextConnector.ActualPoints[1].x + NextConnector.ActualPoints[2].x) / 2;
|
|
NextMody := (NextConnector.ActualPoints[1].y + NextConnector.ActualPoints[2].y) / 2;
|
|
// Ïðè ñîåäèíåíèè êîíåêòîðà ñ ëèíèåé, ñîçäàåòñÿ 2 ëèíèè
|
|
// ïåðåíàçíà÷åíèå ñâÿçåé ëèíèè ê êîòîðîé ïðèñîåäèíèëèñü íîâîìó êîííåêòîðó
|
|
aSnapTrace.ActualPoints[2] := DoublePoint(Modx, Mody);
|
|
aSnapTrace.SetJConnector2(AConnector);
|
|
TPlanConnector(NextConnector).JoinedTraces.Remove(aSnapTrace);
|
|
AddLine := TPlanTrace.Create(Modx, Mody, NextModx, NextMody,
|
|
aSnapTrace.width, ord(aSnapTrace.Style), aSnapTrace.Color, 0, aSnapTrace.LayerHandle, mydsNormal, GCadForm.PCad);
|
|
GCadForm.PCad.AddCustomFigure (GLN(aSnapTrace.LayerHandle), AddLine, false);
|
|
// ïðèñâîèòü ñâÿçè íîâîé îðòîëèíèè
|
|
AddLine.SetJConnector1(AConnector);
|
|
AddLine.SetJConnector2(NextConnector);
|
|
SetConnBringToFront(AConnector);
|
|
|
|
AddLine.FBegSCSID := aSnapTrace.FBegSCSID;
|
|
AddLine.FEndSCSID := aSnapTrace.FEndSCSID;
|
|
RefreshCAD(GCadForm.PCad);
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.SnapToPlanTrace', E.Message);
|
|
end;
|
|
end;
|
|
|
|
function FindSnapOnTraceTraffic(aPlanTrace: TPlanTrace; aEndObject: TPlanObject; aBegObjectType, aEndObjectType: string): Boolean;
|
|
var
|
|
i: integer;
|
|
CheckConnector: TPlanConnector;
|
|
CheckTrace: TPlanTrace;
|
|
Conn1, Conn2: TPlanConnector;
|
|
CheckedX, CheckedY: double;
|
|
x1, x2, y1, y2: double;
|
|
step: double;
|
|
TracesList: TList;
|
|
begin
|
|
try
|
|
Result := false;
|
|
TracesList := TList.create;
|
|
Conn1 := TPlanConnector(aPlanTrace.JoinObject1);
|
|
Conn2 := TPlanConnector(aPlanTrace.JoinObject2);
|
|
for i := 0 to Conn1.JoinedTraces.Count - 1 do
|
|
TracesList.Add(Conn1.JoinedTraces[i]);
|
|
for i := 0 to Conn2.JoinedTraces.Count - 1 do
|
|
TracesList.Add(Conn2.JoinedTraces[i]);
|
|
|
|
// CHECK BY SNAP !!!
|
|
step := GCadForm.PCad.GridStep;
|
|
CheckedX := Conn2.ActualPoints[1].x;
|
|
CheckedY := Conn2.ActualPoints[1].y;
|
|
|
|
// ïî X
|
|
if abs(aPlanTrace.ActualPoints[1].y - aPlanTrace.ActualPoints[2].y) < 0.1 then
|
|
begin
|
|
x1 := aPlanTrace.ActualPoints[1].x;
|
|
x2 := aPlanTrace.ActualPoints[2].x;
|
|
// ïóòü èäåò âïðàâî
|
|
if aPlanTrace.ActualPoints[1].x < aPlanTrace.ActualPoints[2].x then
|
|
begin
|
|
while x1 <= x2 do
|
|
begin
|
|
CheckConnector := CheckByPlanConnector(x1, CheckedY, Conn1, Conn2);
|
|
CheckTrace := CheckByPlanTrace(x1, CheckedY, TracesList);
|
|
if CheckConnector <> nil then
|
|
begin
|
|
if CheckPlanConnectorGoesToEndObject(aEndObject.FSCSID, CheckConnector) then
|
|
begin
|
|
if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckConnector.FBegType, CheckConnector.FEndType) then
|
|
begin
|
|
Conn2.move(x1 - Conn2.ActualPoints[1].x, 0);
|
|
SnapToPlanConnector(Conn2, CheckConnector);
|
|
Result := true;
|
|
// Tolik -- 09/03/2017 -- óòå÷êà ïàìÿòè
|
|
TracesList.Free;
|
|
//
|
|
exit;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
if CheckTrace <> nil then
|
|
begin
|
|
if CheckPlanTraceGoesToEndObject(aEndObject.FSCSID, CheckTrace) then
|
|
begin
|
|
if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckTrace.FBegType, CheckTrace.FEndType) then
|
|
begin
|
|
Conn2.move(x1 - Conn2.ActualPoints[1].x, 0);
|
|
SnapToPlanTrace(Conn2, CheckTrace);
|
|
Result := true;
|
|
// Tolik -- 09/03/2017 -- óòå÷êà ïàìÿòè
|
|
TracesList.Free;
|
|
//
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
x1 := x1 + step;
|
|
end;
|
|
end
|
|
else
|
|
// ïóòü èäåò âëåâî
|
|
if aPlanTrace.ActualPoints[1].x > aPlanTrace.ActualPoints[2].x then
|
|
begin
|
|
while x1 >= x2 do
|
|
begin
|
|
CheckConnector := CheckByPlanConnector(x1, CheckedY, Conn1, Conn2);
|
|
CheckTrace := CheckByPlanTrace(x1, CheckedY, TracesList);
|
|
if CheckConnector <> nil then
|
|
begin
|
|
if CheckPlanConnectorGoesToEndObject(aEndObject.FSCSID, CheckConnector) then
|
|
begin
|
|
if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckConnector.FBegType, CheckConnector.FEndType) then
|
|
begin
|
|
Conn2.move(x1 - Conn2.ActualPoints[1].x, 0);
|
|
SnapToPlanConnector(Conn2, CheckConnector);
|
|
Result := true;
|
|
// Tolik -- 09/03/2017 -- óòå÷êà ïàìÿòè
|
|
TracesList.Free;
|
|
//
|
|
exit;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
if CheckTrace <> nil then
|
|
begin
|
|
if CheckPlanTraceGoesToEndObject(aEndObject.FSCSID, CheckTrace) then
|
|
begin
|
|
if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckTrace.FBegType, CheckTrace.FEndType) then
|
|
begin
|
|
Conn2.move(x1 - Conn2.ActualPoints[1].x, 0);
|
|
SnapToPlanTrace(Conn2, CheckTrace);
|
|
Result := true;
|
|
// Tolik -- 09/03/2017 -- óòå÷êà ïàìÿòè
|
|
TracesList.Free;
|
|
//
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
x1 := x1 - step;
|
|
end;
|
|
end
|
|
end
|
|
else
|
|
// ïî Y
|
|
if abs(aPlanTrace.ActualPoints[1].x - aPlanTrace.ActualPoints[2].x) < 0.1 then
|
|
begin
|
|
y1 := aPlanTrace.ActualPoints[1].y;
|
|
y2 := aPlanTrace.ActualPoints[2].y;
|
|
// ïóòü èäåò âíèç
|
|
if aPlanTrace.ActualPoints[1].y < aPlanTrace.ActualPoints[2].y then
|
|
begin
|
|
while y1 <= y2 do
|
|
begin
|
|
CheckConnector := CheckByPlanConnector(CheckedX, y1, Conn1, Conn2);
|
|
CheckTrace := CheckByPlanTrace(CheckedX, y1, TracesList);
|
|
if CheckConnector <> nil then
|
|
begin
|
|
if CheckPlanConnectorGoesToEndObject(aEndObject.FSCSID, CheckConnector) then
|
|
begin
|
|
if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckConnector.FBegType, CheckConnector.FEndType) then
|
|
begin
|
|
Conn2.move(0, y1 - Conn2.ActualPoints[1].y);
|
|
SnapToPlanConnector(Conn2, CheckConnector);
|
|
Result := true;
|
|
// Tolik -- 09/03/2017 -- óòå÷êà ïàìÿòè
|
|
TracesList.Free;
|
|
//
|
|
exit;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
if CheckTrace <> nil then
|
|
begin
|
|
if CheckPlanTraceGoesToEndObject(aEndObject.FSCSID, CheckTrace) then
|
|
begin
|
|
if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckTrace.FBegType, CheckTrace.FEndType) then
|
|
begin
|
|
Conn2.move(0, y1 - Conn2.ActualPoints[1].y);
|
|
SnapToPlanTrace(Conn2, CheckTrace);
|
|
Result := true;
|
|
// Tolik -- 09/03/2017 -- óòå÷êà ïàìÿòè
|
|
TracesList.Free;
|
|
//
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
y1 := y1 + step;
|
|
end;
|
|
end
|
|
else
|
|
// ïóòü èäåò ââåðõ
|
|
if aPlanTrace.ActualPoints[1].y > aPlanTrace.ActualPoints[2].y then
|
|
begin
|
|
while y1 >= y2 do
|
|
begin
|
|
CheckConnector := CheckByPlanConnector(CheckedX, y1, Conn1, Conn2);
|
|
CheckTrace := CheckByPlanTrace(CheckedX, y1, TracesList);
|
|
if CheckConnector <> nil then
|
|
begin
|
|
if CheckPlanConnectorGoesToEndObject(aEndObject.FSCSID, CheckConnector) then
|
|
begin
|
|
if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckConnector.FBegType, CheckConnector.FEndType) then
|
|
begin
|
|
Conn2.move(0, y1 - Conn2.ActualPoints[1].y);
|
|
SnapToPlanConnector(Conn2, CheckConnector);
|
|
Result := true;
|
|
// Tolik -- 09/03/2017 -- óòå÷êà ïàìÿòè
|
|
TracesList.Free;
|
|
//
|
|
exit;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
if CheckTrace <> nil then
|
|
begin
|
|
if CheckPlanTraceGoesToEndObject(aEndObject.FSCSID, CheckTrace) then
|
|
begin
|
|
if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckTrace.FBegType, CheckTrace.FEndType) then
|
|
begin
|
|
Conn2.move(0, y1 - Conn2.ActualPoints[1].y);
|
|
SnapToPlanTrace(Conn2, CheckTrace);
|
|
Result := true;
|
|
// Tolik -- 09/03/2017 -- óòå÷êà ïàìÿòè
|
|
TracesList.Free;
|
|
//
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
y1 := y1 - step;
|
|
end;
|
|
end
|
|
end
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.FindSnapOnTraceTraffic', E.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure CreatePlanTraceCaption(aPlanTrace: TPlanTrace; aCaption: TStringList);
|
|
var
|
|
i: Integer;
|
|
LHandle: Integer;
|
|
NoteBnd: TDoubleRect;
|
|
CaptionGroup: TRichText;
|
|
TM: TTextMetric;
|
|
xCanvas: TMetafileCanvas;
|
|
h, w: double;
|
|
TraceCP: TDoublePoint;
|
|
MvAngle: Double;
|
|
Bnd: TDoubleRect;
|
|
begin
|
|
try
|
|
LHandle := GCadForm.PCad.GetLayerHandle(1);
|
|
CaptionGroup := TRichText.create(-100, -100, -100, -100,
|
|
1, ord(aPlanTrace.Style), aPlanTrace.color, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad);
|
|
CaptionGroup.re.Font.Size := 6;
|
|
CaptionGroup.re.Font.Color := aPlanTrace.color;
|
|
CaptionGroup.re.Lines.Clear;
|
|
for i := 0 to aCaption.Count - 1 do
|
|
begin
|
|
aCaption[i] := FastReplace(aCaption[i],#13#10,' ');
|
|
CaptionGroup.re.Lines.Add(aCaption[i]);
|
|
end;
|
|
|
|
GCadForm.PCad.AddCustomFigure(1, CaptionGroup, False);
|
|
RefreshCAD(GCadForm.PCad);
|
|
// ïîëó÷èòü ñâîéñòâà
|
|
|
|
// Tolik
|
|
CaptionGroup.ttMetaFile:= TMetaFile.Create;
|
|
CaptionGroup.ttMetafile.Enhanced := True;
|
|
|
|
xCanvas := TMetafileCanvas.Create(CaptionGroup.ttMetafile, 0);
|
|
xCanvas.Font.Name := CaptionGroup.re.Font.Name;
|
|
xCanvas.Font.Size := CaptionGroup.re.Font.Size;
|
|
GetTextMetrics(xCanvas.Handle, TM);
|
|
h := TM.tmHeight / 4 * CaptionGroup.re.Lines.Count + 1;
|
|
w := 0;
|
|
for i := 0 to CaptionGroup.re.Lines.Count - 1 do
|
|
begin
|
|
if w < xCanvas.TextWidth(CaptionGroup.Re.Lines[i]) then
|
|
w := xCanvas.TextWidth(CaptionGroup.Re.Lines[i]);
|
|
end;
|
|
w := (w + 3) / 4 ;
|
|
FreeAndNil(xCanvas);
|
|
CaptionGroup.ttMetaFile.Free;
|
|
// ïåðåñîçäàòü ñ íîâûìè ñâîéñòâàìè
|
|
if CaptionGroup <> nil then
|
|
begin
|
|
GCadForm.PCad.Figures.Remove(CaptionGroup);
|
|
FreeAndNil(CaptionGroup);
|
|
end;
|
|
CaptionGroup := TRichText.create(-100, -100, -100 + w, -100 + h,
|
|
1, ord(aPlanTrace.Style), aPlanTrace.color, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad);
|
|
CaptionGroup.re.Font.Size := 6;
|
|
CaptionGroup.re.Font.Color := aPlanTrace.color;
|
|
CaptionGroup.re.Lines.Clear;
|
|
for i := 0 to aCaption.Count - 1 do
|
|
begin
|
|
aCaption[i] := FastReplace(aCaption[i],#13#10,' ');
|
|
CaptionGroup.re.Lines.Add(aCaption[i]);
|
|
end;
|
|
TraceCP.x := (aPlanTrace.ActualPoints[1].x + aPlanTrace.ActualPoints[2].x) / 2;
|
|
TraceCP.y := (aPlanTrace.ActualPoints[1].y + aPlanTrace.ActualPoints[2].y) / 2;
|
|
CaptionGroup.Move(TraceCP.x - CaptionGroup.CenterPoint.x, TraceCP.y - CaptionGroup.CenterPoint.y);
|
|
CaptionGroup.Move(0, - h / 2);
|
|
|
|
MvAngle := GetPlanTraceAngle(aPlanTrace.ActualPoints[1], aPlanTrace.ActualPoints[2]);
|
|
MvAngle := MvAngle * pi / 180;
|
|
CaptionGroup.Rotate(MvAngle, CaptionGroup.CenterPoint);
|
|
aPlanTrace.Caption := CaptionGroup;
|
|
GCadForm.PCad.AddCustomFigure(1, aPlanTrace.Caption, False);
|
|
RefreshCAD(GCadForm.PCad);
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CreatePlanTraceCaption', E.Message);
|
|
end;
|
|
end;
|
|
|
|
function GetPlanTraceAngle(aPoints1, aPoints2: TDoublePoint): Double;
|
|
var
|
|
Len_X, Len_Y: Double;
|
|
AngleA: Double;
|
|
Degree: Double;
|
|
begin
|
|
try
|
|
Result := 0;
|
|
Degree := 0;
|
|
Len_X := aPoints1.x - aPoints2.x;
|
|
Len_Y := aPoints1.y - aPoints2.y;
|
|
if Len_X = 0 then
|
|
Len_X := 0.001;
|
|
Degree := ArcTan(Len_Y / Len_X) * 180 / pi; // â ãðàäóñàõ
|
|
Degree := round(Degree);
|
|
if Degree = 90 then
|
|
Degree := -90;
|
|
Result := Degree / 180 * pi; // â ðàäèàíàõ
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('U_ProjectPlan.GetPlanTraceAngle', E.Message);
|
|
end;
|
|
end;
|
|
|
|
end.
|