unit U_HouseClasses; interface uses DrawObjects, DrawEngine, PCTypesUtils, Windows, Messages, SysUtils, Classes, Graphics, Dialogs, ComCtrls, Math, PCDrawing, Powercad, menus, rrEllipses, pCDrawBox, FPlan, FastStrings; Type THouse = class; THouseTool = class(TRectangle) constructor create(aX1, aY1, aX2, aY2: Double; w, s, c, abrs, abrc: integer; LHandle: LongInt; aDrawStyle: TDrawStyle; aOwner: TComponent); class function CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure;override; end; THouse = class(TPolyline) private FJoinedIndexes: array of Integer; public FApproachesIndexes: array of Integer; fApproaches: TList; fJoined: TList; isSnap: Boolean; AsEndPoint: Boolean; // êàê òåêóùèé îáúåêò constructor create(Points: TDoublePointArr; w, s, c, abrs, abrc: integer; row: integer; aClosed: Boolean; LHandle: LongInt; aDrawStyle: TDrawStyle; aOwner: TComponent); destructor Destroy; override; procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean); override; Procedure Move(deltax, deltay: double);override; function isPointIn(x,y: double): boolean;override; function isPointInForSnap(x, y: double): boolean; procedure Delete; Procedure InsertKnot(SegNbr:Integer);overload; Procedure DeleteKnot(SegNbr:Integer); overload; Procedure MoveControlPointsOfKnot(KnotNbr: Integer;DeltaX,DeltaY:Double); overload; Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override; Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override; Procedure WriteToStream(Stream: TStream); override; Procedure SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); override; //Tolik //procedure RaiseProperties; procedure RaiseProperties(CadFigList: TList); // function CheakApproachesInHouse(Points: TDoublePointArr): Boolean; end; TApproachTool = class(TRectangle) fHouse: THouse; procedure move(deltax, deltay: double);override; class function CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; override; end; { TApproach = class(TFigureGrp) private FHouseIndex: integer; public fHouse: THouse; procedure Delete; function Edit: Boolean; override; function isPointIn(x,y: double): boolean;override; procedure move(deltax, deltay: double);override; 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 EndRotate(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure; x,y:Double;Shift: TShiftState): boolean; override; Procedure WriteToStream(Stream: TStream); override; Procedure SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); override; procedure RaiseProperties; end; } function CreateApproachText(aRectangle: TFigure): TRichText; procedure ReCreateApproachText(aDrawFigure: TFigureGrp; aCaption: TRichText; aBound: TRectangle); procedure ReCreateApproachIndex(aDrawFigure: TFigureGrp; aCaption: TRichText; aBound: TRectangle; aIndex: Integer); procedure SetApproachIndexInCAD(aListID, aHouseID, aApproachID, aIndex: Integer); var appdeltax: double = 0; appdeltay: double = 0; fByHouseMove: boolean = false; fMoveByApproach: boolean = false; implementation uses U_BaseCommon, U_Common, U_CAD, RichEdit2, U_Constants, U_ESCadClasess; { THouse } destructor THouse.Destroy; begin if TDrawStyle(DrawStyle) <> dsTrace then begin try if (Owner <> nil) and (TPowerCad(Owner).Owner <> nil) then TF_CAD(TPowerCad(Owner ).Owner).FNeedUpdateCheckedFigures := True; except on E: Exception do addExceptionToLogEx('TCabinetExt.Destroy FNeedUpdateCheckedFigures', E.Message); end; end; inherited; end; constructor THouseTool.create(aX1, aY1, aX2, aY2: Double; w, s, c, abrs, abrc: integer; LHandle: LongInt; aDrawStyle: TDrawStyle; aOwner: TComponent); begin try inherited; except on E: Exception do AddExceptionToLogEx('THouseTool.create', E.Message); end; end; class function THouseTool.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var i: Integer; Points: TDoublePointArr; House: THouse; vID: Integer; Joined: TConnectorObject; begin try // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; SetLength(Points, 4); Points[0] := Shadow.ap1; Points[1] := Shadow.ap2; Points[2] := Shadow.ap3; Points[3] := Shadow.ap4; Result := THouse.create(Points, 3, ord(psSolid), clBlack, ord(bsClear), clSilver, 0, True, LHandle, mydsNormal, aOwner); // ñîçäàòü êîííåêòîðû for i := 0 to Length(Points) - 1 do begin Joined := TConnectorObject.Create(Points[i].x, Points[i].y, 0, LHandle, mydsNormal, aOwner); Joined.ConnectorType := ct_Clear; Joined.FIsHouseJoined := True; Joined.FHouse := THouse(Result); GCadForm.PCad.AddCustomFigure (2, Joined, False); THouse(Result).fJoined.Add(Joined); end; vID := CreateHouseInPM(GCadForm.FCADListID); Result.ID := vID; // *UNDO* GCadForm.FCanSaveForUndo := True; except on E: Exception do AddExceptionToLogEx('THouse.CreateFromShadow', E.Message); end; end; { THouse } { THouse } function THouse.CheakApproachesInHouse(Points: TDoublePointArr): Boolean; var i: integer; Approach: TConnectorObject; p1, p2, p3, p4: TDoublePoint; begin try Result := true; for i := 0 to fApproaches.Count - 1 do begin Approach := TConnectorObject(fApproaches[i]); if Approach.DrawFigure <> nil then begin p1 := DoublePoint(Approach.ActualPoints[1].x - Approach.GrpSizeX / 2, Approach.ActualPoints[1].y - Approach.GrpSizeY / 2); p2 := DoublePoint(Approach.ActualPoints[1].x + Approach.GrpSizeX / 2, Approach.ActualPoints[1].y - Approach.GrpSizeY / 2); p3 := DoublePoint(Approach.ActualPoints[1].x + Approach.GrpSizeX / 2, Approach.ActualPoints[1].y + Approach.GrpSizeY / 2); p4 := DoublePoint(Approach.ActualPoints[1].x - Approach.GrpSizeX / 2, Approach.ActualPoints[1].y + Approach.GrpSizeY / 2); end else begin p1 := Approach.ActualPoints[1]; p2 := Approach.ActualPoints[1]; p3 := Approach.ActualPoints[1]; p4 := Approach.ActualPoints[1]; end; if not (PtInPolygon(Points, p1) and PtInPolygon(Points, p2) and PtInPolygon(Points, p3) and PtInPolygon(Points, p4)) then begin Result := false; exit; end; end; except on E: Exception do AddExceptionToLogEx('THouse.CheakApproachesInHouse', E.Message); end; end; constructor THouse.create(Points: TDoublePointArr; w, s, c, abrs, abrc, row: integer; aClosed: Boolean; LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent); begin try Inherited; fApproaches := TList.Create; SetLength(fApproachesIndexes, 0); fJoined := TList.Create; SetLength(fJoinedIndexes, 0); isSnap := False; asEndPoint := false; if aDrawStyle <> dsTrace then TF_CAD(TPowerCad(aOwner).Owner).FNeedUpdateCheckedFigures := True; except on E: Exception do AddExceptionToLogEx('THouse.create', E.Message); end; end; procedure THouse.Delete; var i: Integer; Approach, Joined: TConnectorObject; begin // Tolik 21/05/2019 -- if GPrevFigureTraceTo <> nil then if ID = GPrevFigureTraceTo.ID then GPrevFigureTraceTo := nil; if GPrevFigureSnap <> nil then if ID = GPrevFigureSnap.ID then GPrevFigureSnap := nil; if GFigureSnap <> nil then if ID = GFigureSnap.ID then GFigureSnap := nil; // try if GCadForm <> TF_CAD(Self.Owner.Owner) then exit; if not Deleted then begin Deleted := True; GCadForm.FRemFigures.Add(Self); i := 0; while i < fApproaches.Count do begin Approach := TConnectorObject(fApproaches[i]); Approach.Delete(false, false); end; i := 0; while i < fJoined.Count do begin Joined := TConnectorObject(fJoined[i]); // íåò ïðèñîåäèíåííûõ òðàññ - óäàëèòü if Joined.JoinedOrtholinesList.Count = 0 then begin Joined.Delete(false, false); end else // åñòü òðàññû - ïðåîáðàçîâàòü â îáû÷íûé êîííåêòîð begin fJoined.Remove(Joined); Joined.FHouse := nil; Joined.FIsHouseJoined := False; end; end; end; except on E: Exception do AddExceptionToLogEx('THouse.Delete', E.Message); end; end; procedure THouse.DeleteKnot(SegNbr: Integer); var Seg: TPLSegment; NewSeg: TPLSegment; i: Integer; pt: TDoublePoint; JoinedConn: TConnectorObject; begin try if SegNbr = 0 then exit; if PointCount < 3 then exit; // pt := ActualPoints[SegNbr]; for i := 0 to fJoined.Count - 1 do begin JoinedConn := TConnectorObject(fJoined[i]); if JoinedConn.IsPointIn(pt.x, pt.y) then begin JoinedConn.Delete; break; end; end; // Seg := Segments[SegNbr - 1]; if assigned(seg) then begin for i := segNbr to PointCount - 1 do begin ActualPoints[i] := ActualPoints[i + 1]; OriginalPoints[i] := OriginalPoints[i + 1]; end; PointCount := PointCount - 1; ReDimenPoints; Segments.Remove(seg); Seg.Free; end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure THouse.draw(DEngine: TPCDrawEngine; isGrayed: Boolean); begin try if DrawStyle = mydsNormal then begin if isSnap then begin Color := clRed; end else begin if AsEndPoint then Color := clGreen else Color := clBlack; end; end; inherited; except on E: Exception do AddExceptionToLogEx('THouse.draw', E.Message); end; end; function THouse.EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean; var xp,p1,p2: TDoublePoint; cp1,cp2: TDoublePoint; ptIndex: integer; cindex,r1: integer; ang1,ang2: double; Cad: TPCdrawing; isTan: Boolean; rad1,rad2: double; JoinedConn: TConnectorObject; i: integer; isCanMod: Boolean; Approach: TConnectorObject; Points: TDoublePointArr; Count: Integer; begin try // inherited EndModification(CadControl, mp, TraceFigure, x, y, Shift); Tracing := false; Cad := TPCDrawing(CadControl); p1 := ActualPoints[MP.SeqNbr]; Count := Length(actuals); SetLength(Points, Count); for i := 0 to Count - 1 do begin if (i + 1) = MP.SeqNbr then Points[i] := DoublePoint(ActualPoints[i + 1].x + (x - p1.x), ActualPoints[i + 1].y + (y - p1.y)) else Points[i] := ActualPoints[i + 1]; end; if not CheakApproachesInHouse(Points) then begin SetLength(Points,0); // Tolik 18/05/2018 - - exit; end; ActualPoints[MP.SeqNbr] := DoublePoint(ActualPoints[MP.SeqNbr].x + (x - p1.x), ActualPoints[MP.SeqNbr].y + (y - p1.y)); JoinedConn := nil; for i := 0 to fJoined.Count - 1 do if TConnectorObject(fJoined[i]).IsPointIn(p1.x, p1.y) then JoinedConn := TConnectorObject(fJoined[i]); if JoinedConn <> nil then if not JoinedConn.Selected then JoinedConn.MoveConnector(x - JoinedConn.ActualPoints[1].x, y - JoinedConn.ActualPoints[1].y, false); ResetRegion; Modified := True; except on E: Exception do AddExceptionToLogEx('THouse.EndModification', E.Message); end; end; procedure THouse.InsertKnot(SegNbr: Integer); var Seg: TPLSegment; NewSeg: TPLSegment; i: Integer; pt: TDoublePoint; Joined: TConnectorObject; LHandle: Integer; begin try if SegNbr = 0 then exit; Seg := Segments[SegNbr - 1]; if assigned(seg) then begin PointCount := PointCount + 1; ActualPoints[PointCount] := ActualPoints[PointCount - 1]; OriginalPoints[PointCount] := OriginalPoints[PointCount - 1]; for i := PointCount downto SegNbr + 1 do begin ActualPoints[i] := ActualPoints[i - 1]; OriginalPoints[i] := OriginalPoints[i - 1]; end; if SegNbr + 1 = PointCount then begin ActualPoints[SegNbr + 1] := MPoint(ActualPoints[SegNbr], ActualPoints[1]); OriginalPoints[Segnbr + 1] := MPoint(OriginalPoints[SegNbr], OriginalPoints[1]); pt := ActualPoints[SegNbr + 1]; end else begin ActualPoints[SegNbr + 1] := MPoint(ActualPoints[SegNbr], ActualPoints[SegNbr + 2]); OriginalPoints[Segnbr + 1] := MPoint(OriginalPoints[SegNbr], OriginalPoints[SegNbr + 2]); pt := ActualPoints[SegNbr + 1]; end; // LHandle := GCadForm.PCad.GetLayerHandle(2); Joined := TConnectorObject.Create(pt.x, pt.y, 0, LHandle, mydsNormal, GCadForm.PCad); Joined.ConnectorType := ct_Clear; Joined.FIsHouseJoined := True; Joined.FHouse := Self; GCadForm.PCad.AddCustomFigure (2, Joined, False); fJoined.Add(Joined); // SegMents.Move(PointCount - 1, SegNbr); Seg := Segments[SegNbr - 1]; ArrangeSegment(SegNbr, Seg.SType); ArrangeSegment(SegNbr + 1, Seg.SType); end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; function THouse.isPointIn(x, y: double): boolean; var a : integer; lp: Integer; begin try result := false; result := isPointInForSnap(x, y); exit; begin //Tolik {if IsPointInRegion(x,y) then result := true;} result := IsPointInRegionByRegObj(x, y); // end; if result = true then exit; if closed then lp := PointCount else lp := pointcount-1; For a := 1 to lp do begin if IsPointInSegment(a, x, y) then begin result := true; SelectedPoint := a; exit; end; end; except on E: Exception do AddExceptionToLogEx('THouse.isPointIn', E.Message); end; end; function THouse.isPointInForSnap(x, y: double): boolean; var a : integer; lp: Integer; begin result := false; if closed then lp := PointCount else lp := pointcount-1; For a := 1 to lp do begin if IsPointInSegment(a, x, y) then begin result := true; SelectedPoint := a; exit; end; end; end; procedure THouse.Move(deltax, deltay: double); var a: integer; JoinedConn: TConnectorObject; begin try for a := 1 to pointcount do begin originalpoints[a] := DoublePoint(originalpoints[a].x + deltax, originalpoints[a].y + deltay); Actualpoints[a] := DoublePoint(actualpoints[a].x + deltax, actualpoints[a].y + deltay); end; ResetRegion; InMoveList := False; for a := 0 to Segments.count - 1 do TPlSegment(Segments[a]).Move(deltaX, deltaY); fByHouseMove := True; for a := 0 to fJoined.Count - 1 do begin JoinedConn := TConnectorObject(fJoined[a]); if not JoinedConn.Selected then JoinedConn.MoveConnector(deltax, deltay, false); end; for a := 0 to fApproaches.Count - 1 do if not TConnectorObject(fApproaches[a]).Selected then TConnectorObject(fApproaches[a]).move(deltaX, deltaY); fByHouseMove := false; except on E: Exception do AddExceptionToLogEx('THouse.Move', E.Message); end; end; procedure THouse.MoveControlPointsOfKnot(KnotNbr: Integer; DeltaX, DeltaY: Double); begin try inherited; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure THouse.RaiseProperties(CadFigList: TList); var i: integer; Approach: TConnectorObject; Joined: TConnectorObject; FiguresList: TList; begin try inherited; if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else //Tolik // FiguresList := GCadForm.PCad.Figures; FiguresList := CadFigList; // for i := 0 to Length(FApproachesIndexes) - 1 do begin Approach := TConnectorObject(FiguresList.Items[FApproachesIndexes[i]]); fApproaches.Add(Approach); end; for i := 0 to Length(FJoinedIndexes) - 1 do begin Joined := TConnectorObject(FiguresList.Items[FJoinedIndexes[i]]); FJoined.Add(Joined); end; if AsEndPoint then begin GEndPoint := Self; GListWithEndPoint := GCadForm; end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure THouse.SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); var FindCode: Integer; xInt: Integer; xParam: byte; begin try inherited; if (xCode >= 30) AND (xCode <= 49) then begin FindCode := Length(fApproachesIndexes); FindCode := FindCode + 1; SetLength(fApproachesIndexes, FindCode); xInt := pInt(data)^; fApproachesIndexes[FindCode - 1] := xInt; end; if (xCode >= 50) AND (xCode <= 69) then begin FindCode := Length(fJoinedIndexes); FindCode := FindCode + 1; SetLength(fJoinedIndexes, FindCode); xInt := pInt(data)^; fJoinedIndexes[FindCode - 1] := xInt; end; if xCode = 101 then begin xParam := pByte(data)^; if xParam = 0 then AsEndPoint := true else AsEndPoint := false; end; if fApproaches = nil then fApproaches := TList.Create; if fJoined = nil then fJoined := TList.Create; TF_CAD(TPowerCad(Owner).Owner).FNeedUpdateCheckedFigures := True; except on E: Exception do AddExceptionToLogEx('THouse.SetPropertyFromStream', E.Message); end; end; function THouse.TraceModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean; begin try inherited TraceModification(CadControl, mp, TraceFigure, x, y, Shift); except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure THouse.WriteToStream(Stream: TStream); var i: integer; xInt: Integer; FiguresList: TList; xParam: byte; begin try inherited; if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := GCadForm.PCad.Figures; for i := 0 to fApproaches.Count - 1 do begin xInt := FiguresList.IndexOf(fApproaches[i]); if ((30 + i) <= 49) then WriteField(30 + i, Stream, xInt, sizeof(xInt)) end; for i := 0 to fJoined.Count - 1 do begin xInt := FiguresList.IndexOf(fJoined[i]); if ((50 + i) <= 69) then WriteField(50 + i, Stream, xInt, sizeof(xInt)) end; if AsEndPoint then xParam := 0 else xParam := 1; WriteField(101, Stream, xParam, sizeof(xParam)); except on E: Exception do AddExceptionToLogEx('THouse.WriteToStream', E.Message); end; end; { TApproachTool } function CreateApproachText(aRectangle: TFigure): TRichText; var Caption: TRichText; i, k: Integer; LHandle: Integer; Block: TBlock; BlockBnd: TDoubleRect; BlockX, BlockY: double; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; BlockCP: TDoublePoint; begin try Result := nil; LHandle := GCadForm.PCad.GetLayerHandle(8); BlockBnd := aRectangle.GetBoundRect; BlockX := abs(BlockBnd.Left - BlockBnd.Right); BlockY := abs(BlockBnd.Top - BlockBnd.Bottom); for k := 14 downto 1 do begin Caption := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad); Caption.re.Font.Size := k; Caption.RE.Lines.Clear; if Caption.RE.Font.Name = 'GOST' then //Caption.re.Lines.Add('#' + Inttostr(GCadForm.FActiveHouse.fApproaches.Count + 1)) Caption.re.Lines.Add(CHR(35) + Inttostr(GCadForm.FActiveHouse.fApproaches.Count + 1)) else Caption.re.Lines.Add(CHR(185) + Inttostr(GCadForm.FActiveHouse.fApproaches.Count + 1)); {if Caption.re.Font.Name = 'GOST' then Caption.re.Font.Charset := 204; } GCadForm.PCad.AddCustomFigure(8, Caption, False); RefreshCAD(GCadForm.PCad); // ïîëó÷èòü ñâîéñòâà // Tolik -- 13/01/2017 Caption.ttMetaFile := TMetaFile.Create; Caption.ttMetafile.Enhanced := True; // xCanvas := TMetafileCanvas.Create(Caption.ttMetafile, 0); xCanvas.Font.Name := Caption.re.Font.Name; xCanvas.Font.Size := Caption.re.Font.Size; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * Caption.re.Lines.Count + 1; w := 0; for i := 0 to Caption.re.Lines.Count - 1 do begin if w < xCanvas.TextWidth(Caption.Re.Lines[i]) then w := xCanvas.TextWidth(Caption.Re.Lines[i]); end; w := (w + 3) / 4 ; FreeAndNil(xCanvas); Caption.ttMetaFile.Free; // ïåðåñîçäàòü ñ íîâûìè ñâîéñòâàìè if Caption <> nil then begin GCadForm.PCad.Figures.Remove(Caption); FreeAndNil(Caption); end; if (k = 1) or (w < BlockX) and (h < BlockY) then begin Caption := TRichText.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad); {if Caption.re.Font.Name = 'GOST' then Caption.re.Font.Charset := 204; } Caption.re.Font.Size := k; Caption.RE.Lines.Clear; //Caption.re.Lines.Add('#' + Inttostr(GCadForm.FActiveHouse.fApproaches.Count + 1)); if Caption.RE.Font.Name = 'GOST' then //Caption.re.Lines.Add('#' + Inttostr(GCadForm.FActiveHouse.fApproaches.Count + 1)) Caption.re.Lines.Add(CHR(35) + Inttostr(GCadForm.FActiveHouse.fApproaches.Count + 1)) else Caption.re.Lines.Add(CHR(185) + Inttostr(GCadForm.FActiveHouse.fApproaches.Count + 1)); RefreshCAD(GCadForm.PCad); Break; end; end; // ïîäãîíêà ïîäïèñè ïîä ÓÎ BlockCP.x := BlockBnd.Left + BlockX / 2; BlockCP.y := BlockBnd.Top + BlockY / 2; Caption.Move(BlockCP.x - Caption.CenterPoint.x, BlockCP.y - Caption.CenterPoint.y); Result := Caption; RefreshCAD(GCadForm.PCad); except on E: Exception do AddExceptionToLogEx('TApproachTool.CreateApproachText', E.Message); end; end; procedure ReCreateApproachText(aDrawFigure: TFigureGrp; aCaption: TRichText; aBound: TRectangle); var i: integer; LHandle: integer; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; vAngle: Double; BlockBnd: TDoubleRect; BlockX, BlockY: double; BlockCP: TDoublePoint; Caption: TRichText; vFont: TFont; CapStrings: TStringList; begin try LHandle := GCadForm.PCad.GetLayerHandle(8); CapStrings := TStringList.Create; vFont := Tfont.Create; vFont.Name := aCaption.re.SelAttributes.Name; vFont.Size := aCaption.re.SelAttributes.Size; vFont.Color := aCaption.re.SelAttributes.Color; vFont.Style := aCaption.re.SelAttributes.Style; for i := 0 to aCaption.re.Lines.Count - 1 do CapStrings.Add(aCaption.re.Lines[i]); if aCaption <> nil then begin aDrawFigure.RemoveFromGrp(aCaption); //28.04.2011 aDrawFigure.InFigures.Remove(aCaption); FreeAndNil(aCaption); end; Caption := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad); Caption.RE.Lines.Clear; Caption.re.Font.Name := vFont.Name; Caption.re.Font.Size := vFont.Size; Caption.re.Font.Color := vFont.Color; Caption.re.Font.Style := vFont.Style; for i := 0 to CapStrings.Count - 1 do Caption.RE.Lines.Add(FastReplace(CapStrings[i],#13#10,' ')); // ÏÎËÓ×ÈÒÜ ÑÂÎÉÑÒÂÀ // Tolik -- 13/01/2017 Caption.ttMetaFile := TMetaFile.Create; Caption.ttMetafile.Enhanced := True; // xCanvas := TMetafileCanvas.Create(Caption.ttMetaFile, 0); xCanvas.Font := Caption.re.Font; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * Caption.re.Lines.Count + 1; w := 0; for i := 0 to Caption.re.Lines.Count - 1 do begin if w < xCanvas.TextWidth(Caption.Re.Lines[i]) then w := xCanvas.TextWidth(Caption.Re.Lines[i]); end; w := (w + 3) / 4 ; FreeAndNil(xCanvas); Caption.ttMetaFile.Free; // ÏÅÐÅÑÎÇÄÀÒÜ Ñ ÍÎÂÛÌÈ ÑÂÎÉÑÒÂÀÌÈ if Caption <> nil then FreeAndNil(Caption); Caption := TRichText.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad); Caption.RE.Lines.Clear; Caption.re.Font.Name := vFont.Name; Caption.re.Font.Size := vFont.Size; Caption.re.Font.Color := vFont.Color; Caption.re.Font.Style := vFont.Style; for i := 0 to CapStrings.Count - 1 do Caption.RE.Lines.Add(FastReplace(CapStrings[i],#13#10,' ')); BlockBnd := aBound.GetBoundRect; BlockX := abs(BlockBnd.Left - BlockBnd.Right); BlockY := abs(BlockBnd.Top - BlockBnd.Bottom); // ïîäãîíêà ïîäïèñè ïîä ÓÎ BlockCP.x := BlockBnd.Left + BlockX / 2; BlockCP.y := BlockBnd.Top + BlockY / 2; Caption.Move(BlockCP.x - Caption.CenterPoint.x, BlockCP.y - Caption.CenterPoint.y); vAngle := aBound.AngletoPoint; vAngle := GetLineAngle(aBound.ap1, aBound.ap2); vAngle := DegToRad(vAngle); Caption.Rotate(vAngle); aDrawFigure.AddToGrp(Caption); //28.04.2011 aDrawFigure.InFigures.Add(Caption); except on E: Exception do AddExceptionToLogEx('U_HouseClasses.ReCreateApproachText', E.Message); end; end; procedure ReCreateApproachIndex(aDrawFigure: TFigureGrp; aCaption: TRichText; aBound: TRectangle; aIndex: Integer); var i: integer; LHandle: integer; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; vAngle: Double; BlockBnd: TDoubleRect; BlockX, BlockY: double; BlockCP: TDoublePoint; Caption: TRichText; vFont: TFont; CapStrings: TStringList; begin try LHandle := GCadForm.PCad.GetLayerHandle(8); CapStrings := TStringList.Create; CapStrings.Add(IntToStr(aIndex)); vFont := Tfont.Create; vFont.Name := aCaption.re.SelAttributes.Name; vFont.Size := aCaption.re.SelAttributes.Size; vFont.Color := aCaption.re.SelAttributes.Color; vFont.Style := aCaption.re.SelAttributes.Style; if aCaption <> nil then begin aDrawFigure.RemoveFromGrp(aCaption); //28.04.2011 aDrawFigure.InFigures.Remove(aCaption); FreeAndNil(aCaption); end; Caption := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad); Caption.RE.Lines.Clear; Caption.re.Font.Name := vFont.Name; Caption.re.Font.Size := vFont.Size; Caption.re.Font.Color := vFont.Color; Caption.re.Font.Style := vFont.Style; for i := 0 to CapStrings.Count - 1 do Caption.RE.Lines.Add(FastReplace(CapStrings[i],#13#10,' ')); // ÏÎËÓ×ÈÒÜ ÑÂÎÉÑÒÂÀ // Tolik -- 13/01/2017 Caption.ttMetaFile := TMetaFile.Create; Caption.ttMetafile.Enhanced := True; // xCanvas := TMetafileCanvas.Create(Caption.ttMetaFile, 0); xCanvas.Font := Caption.re.Font; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * Caption.re.Lines.Count + 1; w := 0; for i := 0 to Caption.re.Lines.Count - 1 do begin if w < xCanvas.TextWidth(Caption.Re.Lines[i]) then w := xCanvas.TextWidth(Caption.Re.Lines[i]); end; w := (w + 3) / 4 ; FreeAndNil(xCanvas); Caption.ttMetaFile.Free; // ÏÅÐÅÑÎÇÄÀÒÜ Ñ ÍÎÂÛÌÈ ÑÂÎÉÑÒÂÀÌÈ if Caption <> nil then FreeAndNil(Caption); Caption := TRichText.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad); Caption.RE.Lines.Clear; Caption.re.Font.Name := vFont.Name; Caption.re.Font.Size := vFont.Size; Caption.re.Font.Color := vFont.Color; Caption.re.Font.Style := vFont.Style; for i := 0 to CapStrings.Count - 1 do Caption.RE.Lines.Add(FastReplace(CapStrings[i],#13#10,' ')); BlockBnd := aBound.GetBoundRect; BlockX := abs(BlockBnd.Left - BlockBnd.Right); BlockY := abs(BlockBnd.Top - BlockBnd.Bottom); // ïîäãîíêà ïîäïèñè ïîä ÓÎ BlockCP.x := BlockBnd.Left + BlockX / 2; BlockCP.y := BlockBnd.Top + BlockY / 2; Caption.Move(BlockCP.x - Caption.CenterPoint.x, BlockCP.y - Caption.CenterPoint.y); vAngle := aBound.AngletoPoint; vAngle := GetLineAngle(aBound.ap1, aBound.ap2); vAngle := DegToRad(vAngle); Caption.Rotate(vAngle); aDrawFigure.AddToGrp(Caption); //28.04.2011 aDrawFigure.InFigures.Add(Caption); except on E: Exception do AddExceptionToLogEx('U_HouseClasses.ReCreateApproachIndex', E.Message); end; end; procedure SetApproachIndexInCAD(aListID, aHouseID, aApproachID, aIndex: Integer); var i: integer; vList: TF_CAD; vHouse: THouse; vApproach: TConnectorObject; vCaption: TRichText; vBound: TRectangle; begin try vList := GetListByID(aListID); if vList = nil then exit; vHouse := GetHouseByID(vList, aHouseID); vApproach := GetApproachByComponID(vList, aApproachID); if (vHouse = nil) or (vApproach = nil) then exit; vCaption := nil; vBound := nil; for i := 0 to vApproach.DrawFigure.InFigures.Count - 1 do begin if CheckFigureByClassName(TFigure(vApproach.DrawFigure.InFigures[i]), 'TRichText') then vCaption := TRichText(vApproach.DrawFigure.InFigures[i]) else if CheckFigureByClassName(TFigure(vApproach.DrawFigure.InFigures[i]), 'TRectangle') then vBound := TRectangle(vApproach.DrawFigure.InFigures[i]); end; if (vCaption <> nil) and (vBound <> nil) then ReCreateApproachIndex(vApproach.DrawFigure, vCaption, vBound, aIndex); except on E: Exception do AddExceptionToLogEx('U_HouseClasses.SetApproachIndexInCAD', E.Message); end; end; class function TApproachTool.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var vApproach: TConnectorObject; vRectangle: TRectangle; vCaption: TRichText; vDrawFigure: TFigureGrpMod; isCreate: Boolean; vID, vIDCompon: Integer; x, y, z: Double; begin try // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; // Ñîçäàâàòü Result := nil; isCreate := True; { if not GCadForm.FActiveHouse.IsPointInRegion(Shadow.ap1.x,Shadow.ap1.y) then isCreate := False; if not GCadForm.FActiveHouse.IsPointInRegion(Shadow.ap2.x,Shadow.ap2.y) then isCreate := False; if not GCadForm.FActiveHouse.IsPointInRegion(Shadow.ap3.x,Shadow.ap3.y) then isCreate := False; if not GCadForm.FActiveHouse.IsPointInRegion(Shadow.ap4.x,Shadow.ap4.y) then isCreate := False; } //Tolik if not GCadForm.FActiveHouse.IsPointInRegionByRegObj(Shadow.ap1.x,Shadow.ap1.y) then isCreate := False; if not GCadForm.FActiveHouse.IsPointInRegionByRegObj(Shadow.ap2.x,Shadow.ap2.y) then isCreate := False; if not GCadForm.FActiveHouse.IsPointInRegionByRegObj(Shadow.ap3.x,Shadow.ap3.y) then isCreate := False; if not GCadForm.FActiveHouse.IsPointInRegionByRegObj(Shadow.ap4.x,Shadow.ap4.y) then isCreate := False; // if isCreate then begin x := abs(Shadow.ap1.x + Shadow.ap2.x) / 2; y := abs(Shadow.ap1.y + Shadow.ap4.y) / 2; z := 0; vApproach := TConnectorObject.Create(X, Y, Z, LHandle, mydsNormal, GCadForm.PCad); vApproach.ConnectorType := ct_NB; vRectangle := TRectangle.create(Shadow.ap1.x,Shadow.ap1.y, Shadow.ap3.x,Shadow.ap3.y, GCadForm.PCad.DefaultPenWidth, ord(GCadForm.PCad.DefaultPenStyle), GCadForm.PCad.DefaultPenColor, ord(GCadForm.PCad.DefaultBrushStyle), GCadForm.PCad.DefaultBrushColor, LHandle, mydsNormal, GCadForm.PCad); vCaption := CreateApproachText(vRectangle); vDrawFigure := TFigureGrpMod.create(LHandle, aOwner); vDrawFigure.AddFigure(vRectangle); vDrawFigure.AddFigure(vCaption); vID := CreateApproachInPM(GCadForm.FCADListID, GCadForm.FActiveHouse.ID, vIDCompon); vApproach.ID := vID; vApproach.FComponID := vIDCompon; vApproach.DrawFigure := vDrawFigure; vApproach.FIsApproach := True; vApproach.Name := cHouse_Mes2; Result := vApproach; // := Tfigure(GCadForm.PCad.AddCustomFigure(8, vApproach, False)); TConnectorObject(Result).fHouse := GCadForm.FActiveHouse; GCadForm.FActiveHouse.fApproaches.Add(Result); end else begin ShowMessage(cHouse_Mes1); end; GCadForm.FCanSaveForUndo := True; except on E: Exception do AddExceptionToLogEx('TApproachTool.CreateFromShadow', E.Message); end; end; procedure TApproachTool.move(deltax, deltay: double); var isCreate: Boolean; begin try isCreate := True; { if not fHouse.IsPointInRegion(ap1.x + deltax, ap1.y + deltay) then isCreate := False; if not fHouse.IsPointInRegion(ap2.x + deltax, ap2.y + deltay) then isCreate := False; if not fHouse.IsPointInRegion(ap3.x + deltax, ap3.y + deltay) then isCreate := False; if not fHouse.IsPointInRegion(ap4.x + deltax, ap4.y + deltay) then isCreate := False;} //Tolik if not fHouse.IsPointInRegionByRegObj(ap1.x + deltax, ap1.y + deltay) then isCreate := False; if not fHouse.IsPointInRegionByRegObj(ap2.x + deltax, ap2.y + deltay) then isCreate := False; if not fHouse.IsPointInRegionByRegObj(ap3.x + deltax, ap3.y + deltay) then isCreate := False; if not fHouse.IsPointInRegionByRegObj(ap4.x + deltax, ap4.y + deltay) then isCreate := False; // if isCreate then begin appdeltax := appdeltax + deltax; appdeltay := appdeltay + deltay; inherited; end; except on E: Exception do AddExceptionToLogEx('TApproachTool.move', E.Message); end; end; { function TApproach.CreateModification: TFigure; var r: TDoubleRect; res: TRectangle; begin try res := TApproachTool.create(0, 0, 0, 0, 1, 1, clLime, 0, 0, 0, dsTrace, nil); r := GetBoundRect; res.actualpoints[1] := DoublePoint(r.left, r.top); res.actualpoints[2] := DoublePoint(r.right, r.top); res.actualpoints[3] := DoublePoint(r.right, r.bottom); res.actualpoints[4] := DoublePoint(r.left, r.bottom); Res.DiagonalScale := DiagonalScale; res.RotPoint := RotPoint; TApproachTool(res).fHouse := fHouse; result := res; fdeltax := 0; fdeltay := 0; fMoveByMouse := True; except on E: Exception do AddExceptionToLogEx('TApproach.CreateModification', E.Message); end; end; procedure TApproach.Delete; begin try if not Deleted then begin Deleted := True; GCadForm.FRemFigures.Add(Self); fHouse.fApproaches.Remove(Self); end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; function TApproach.Edit: Boolean; begin try except on E: Exception do AddExceptionToLogEx('TApproach.Edit', E.Message); end; end; function TApproach.EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean; begin try inherited EndModification(CadControl, mp, TraceFigure, x, y, Shift); except on E: Exception do AddExceptionToLogEx('TApproach.EndModification', E.Message); end; end; function TApproach.EndRotate(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean; var s: Integer; a1, a2, a: Double; isCreate: Boolean; begin try if mp.SeqNbr = 5 then begin RotPoint := TraceFigure.RotPoint; end else begin a1 := GetRadOfLine(rotPoint,DoublePoint(mp.CoordX ,mp.CoordY)); a2 := GetRadOfLine(rotPoint,DoublePoint(x,y)); a := a2-a1; s := sign(a); a := abs(a); if abs(a - 0) < (pi / 180) * 5 then a := 0; if abs(a - pi / 2) < (pi / 180) * 5 then a := pi / 2; if abs(a - 3 * (pi / 2)) < (pi / 180) * 5 then a := 3 * (pi / 2); if abs(a - pi) < (pi / 180) * 5 then a := pi; if abs(a - 2 * pi) < (pi / 180) * 5 then a := 2 * pi; Rotate(s * a, RotPoint); isCreate := True; if not fHouse.IsPointInRegion(ap1.x, ap1.y) then isCreate := False; if not fkHouse.IsPointInRegion(ap2.x, ap2.y) then isCreate := False; if not fHouse.IsPointInRegion(ap3.x, ap3.y) then isCreate := False; if not fHouse.IsPointInRegion(ap4.x, ap4.y) then isCreate := False; if not isCreate then begin ShowMessage(cHouse_Mes1); Rotate(- s * a, RotPoint); end; end; except on E: Exception do AddExceptionToLogEx('TApproach.EndRotate', E.Message); end; end; function TApproach.isPointIn(x, y: double): boolean; var a: integer; f: TFigure; begin try result := false; begin for a := 0 to inFigures.Count - 1 do begin result := TFigure(InFigures[a]).isPointInRegion(x,y); if result then exit; end; end; except on E: Exception do AddExceptionToLogEx('TApproach.isPointIn', E.Message); end; end; procedure TApproach.move(deltax, deltay: double); var isCreate: Boolean; begin try // âûçîâ ïåðåìåùåíèå if fManualMove then begin inherited; end else // ñðàáàòûâàíèå îáðàáîò÷èêà MOVE begin // Mouse if fMoveByMouse then begin deltax := fdeltax; deltay := fdeltay; inherited; fMoveByMouse := False; end else // Arrows begin isCreate := True; if not fHouse.IsPointInRegion(ap1.x + deltax, ap1.y + deltay) then isCreate := False; if not fHouse.IsPointInRegion(ap2.x + deltax, ap2.y + deltay) then isCreate := False; if not fHouse.IsPointInRegion(ap3.x + deltax, ap3.y + deltay) then isCreate := False; if not fHouse.IsPointInRegion(ap4.x + deltax, ap4.y + deltay) then isCreate := False; if isCreate then inherited; end; end; except on E: Exception do AddExceptionToLogEx('TApproach.move', E.Message); end; end; procedure TApproach.RaiseProperties; var i: integer; FiguresList: TList; begin try if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := GCadForm.PCad.Figures; if FHouseIndex = - 1 then begin fHouse := Nil; end else begin fHouse := THouse(FiguresList.Items[FHouseIndex]); end; except on E: Exception do AddExceptionToLogEx('TApproach.RaiseProperties', E.Message); end; end; procedure TApproach.SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); var xInt: Integer; begin try inherited; case xCode of 30: begin xInt := pInt(data)^; FHouseIndex := xInt; end; end; except on E: Exception do AddExceptionToLogEx('TApproach.SetPropertyFromStream', E.Message); end; end; function TApproach.TraceModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean; var GRect: TDoubleRect; isTrace: Boolean; p1_in: boolean; p2_in: boolean; begin try If MP.SeqNbr in [3,4,5] then begin p1_in := fHouse.IsPointInRegion(x,TraceFigure.ActualPoints[2].y); p2_in := fHouse.IsPointInRegion(x,TraceFigure.ActualPoints[3].y); if p1_in and p2_in then begin TraceFigure.ActualPoints[2] := DoublePoint(x,TraceFigure.ActualPoints[2].y); TraceFigure.ActualPoints[3] := DoublePoint(x,TraceFigure.ActualPoints[3].y); end; end else if MP.SeqNbr in [1,8,7] then begin p1_in := fHouse.IsPointInRegion(x,TraceFigure.ActualPoints[1].y); p2_in := fHouse.IsPointInRegion(x,TraceFigure.ActualPoints[4].y); if p1_in and p2_in then begin TraceFigure.ActualPoints[1] := DoublePoint(x,TraceFigure.ActualPoints[1].y); TraceFigure.ActualPoints[4] := DoublePoint(x,TraceFigure.ActualPoints[4].y); end; end; If mp.SeqNbr in [1,2,3] then begin p1_in := fHouse.IsPointInRegion(TraceFigure.ActualPoints[1].x,y); p2_in := fHouse.IsPointInRegion(TraceFigure.ActualPoints[2].x,y); if p1_in and p2_in then begin TraceFigure.ActualPoints[1] := DoublePoint(TraceFigure.ActualPoints[1].x,y); TraceFigure.ActualPoints[2] := DoublePoint(TraceFigure.ActualPoints[2].x,y); end; end else if mp.SeqNbr in [5,6,7] then begin p1_in := fHouse.IsPointInRegion(TraceFigure.ActualPoints[3].x,y); p2_in := fHouse.IsPointInRegion(TraceFigure.ActualPoints[4].x,y); if p1_in and p2_in then begin TraceFigure.ActualPoints[3] := DoublePoint(TraceFigure.ActualPoints[3].x,y); TraceFigure.ActualPoints[4] := DoublePoint(TraceFigure.ActualPoints[4].x,y); end; end; except on E: Exception do AddExceptionToLogEx('TApproach.TraceModification', E.Message); end; end; procedure TApproach.WriteToStream(Stream: TStream); var xInt: Integer; FiguresList: TList; begin try inherited; if GCadForm.FUndoStatus then FiguresList := GCadForm.FUndoFiguresList else FiguresList := GCadForm.PCad.Figures; if fHouse <> nil then begin xInt := FiguresList.IndexOf(fHouse); WriteField(30, Stream, xInt, sizeof(xInt)); end else begin xInt := -1; WriteField(30, Stream, xInt, sizeof(xInt)); end; except on E: Exception do AddExceptionToLogEx('TApproach.WriteToStream', E.Message); end; end; } end.