function TmsTriangleDirectionRight.Polygon: TPolygon; begin SetLength(Result, 4); Result[0] := TPointF.Create(StartPoint.X - InitialHeight / 2, StartPoint.Y - InitialHeight / 2); Result[1] := TPointF.Create(StartPoint.X - InitialHeight / 2, StartPoint.Y + InitialHeight / 2); Result[2] := TPointF.Create(StartPoint.X + InitialHeight / 2, StartPoint.Y); Result[3] := Result[0]; end;
type TmsSmallTriangle = class(TmsTriangleDirectionRight) protected function FillColor: TAlphaColor; override; public class function InitialHeight: Single; override; end; // TmsSmallTriangle
procedure TmsLineWithArrow.DoDrawTo(const aCtx: TmsDrawContext); var l_Proxy : TmsShape; l_OriginalMatrix: TMatrix; l_Matrix: TMatrix; l_Angle : Single; l_CenterPoint : TPointF; l_TextRect : TRectF; begin inherited; if (StartPoint <> FinishPoint) then begin l_OriginalMatrix := aCtx.rCanvas.Matrix; try l_Proxy := TmsSmallTriangle.Create(FinishPoint); try // 0 , // l_Angle := DegToRad(0); l_CenterPoint := TPointF.Create(FinishPoint.X , FinishPoint.Y); // l_Matrix := l_OriginalMatrix; // l_Matrix := l_Matrix * TMatrix.CreateTranslation(-l_CenterPoint.X, -l_CenterPoint.Y); // - l_Matrix := l_Matrix * TMatrix.CreateRotation(l_Angle); // l_Matrix := l_Matrix * TMatrix.CreateTranslation(l_CenterPoint.X, l_CenterPoint.Y); // aCanvas.SetMatrix(l_Matrix); // l_Proxy.DrawTo(aCanvas, aOrigin); finally FreeAndNil(l_Proxy); end; // try..finally finally // , . aCanvas.SetMatrix(l_OriginalMatrix); end; end;//(StartPoint <> FinishPoint) end;
function TmsLineWithArrow.GetArrowAngleRotation: Single; var l_ALength, l_CLength, l_AlphaAngle, l_X, l_Y, l_RotationAngle: Single; l_PointC: TPointF; l_Invert: SmallInt; begin Result := 0; // l_X := (FinishPoint.X - StartPoint.X) * (FinishPoint.X - StartPoint.X); l_Y := (FinishPoint.Y - StartPoint.Y) * (FinishPoint.Y - StartPoint.Y); // l_CLength := sqrt(l_X + l_Y); l_PointC := TPointF.Create(FinishPoint.X, StartPoint.Y); // l_X := (l_PointC.X - StartPoint.X) * (l_PointC.X - StartPoint.X); l_Y := (l_PointC.Y - StartPoint.Y) * (l_PointC.Y - StartPoint.Y); // l_ALength := sqrt(l_X + l_Y); // l_AlphaAngle := ArcSin(l_ALength / l_CLength); l_RotationAngle := 0; l_Invert := 1; if FinishPoint.X > StartPoint.X then begin l_RotationAngle := Pi / 2 * 3; if FinishPoint.Y > StartPoint.Y then l_Invert := -1; end else begin l_RotationAngle := Pi / 2; if FinishPoint.Y < StartPoint.Y then l_Invert := -1; end; Result := l_Invert * (l_AlphaAngle + l_RotationAngle); end;
function TmsRectangle.ContainsPt(const aPoint: TPointF): Boolean; var l_Finish : TPointF; l_Rect: TRectF; begin Result := False; l_Finish := TPointF.Create(StartPoint.X + InitialWidth, StartPoint.Y + InitialHeight); l_Rect := TRectF.Create(StartPoint,l_Finish); Result := l_Rect.Contains(aPoint); end;
class function TmsShape.ShapeByPt(const aPoint: TPointF; aList: TmsShapeList): TmsShape; var l_Shape: TmsShape; l_Index: Integer; begin Result := nil; for l_Index := aList.Count - 1 downto 0 do begin l_Shape := aList.Items[l_Index]; if l_Shape.ContainsPt(aPoint) then begin Result := l_Shape; Exit; end; // l_Shape.ContainsPt(aPoint) end; // for l_Index end;
type TmsDrawContext = record public rCanvas: TCanvas; rOrigin: TPointF; rMoving: Boolean; // - , - constructor Create(const aCanvas: TCanvas; const aOrigin: TPointF); end; // TmsDrawContext
procedure TmsShape.DrawTo(const aCtx: TmsDrawContext); begin aCtx.rCanvas.Fill.Color := FillColor; if aCtx.rMoving then begin aCtx.rCanvas.Stroke.Dash := TStrokeDash.sdDashDot; aCtx.rCanvas.Stroke.Color := TAlphaColors.Darkmagenta; aCtx.rCanvas.Stroke.Thickness := 4; end else begin aCtx.rCanvas.Stroke.Dash := StrokeDash; aCtx.rCanvas.Stroke.Color := StrokeColor; aCtx.rCanvas.Stroke.Thickness := StrokeThickness; end; DoDrawTo(aCtx); end;
class function TmsShape.Make(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList): TmsShape; begin Result := Create(aStartPoint); end;
class function TmsMover.Make(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList): TmsShape; var l_Moving: TmsShape; begin // l_Moving := ShapeByPt(aStartPoint, aListWithOtherShapes); if (l_Moving <> nil) then Result := Create(aStartPoint, aListWithOtherShapes, l_Moving) else Result := nil; end;
type TmsMover = class(TmsShape) private f_Moving: TmsShape; f_ListWithOtherShapes: TmsShapeList; protected procedure DoDrawTo(const aCtx: TmsDrawContext); override; constructor Create(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList; aMoving: TmsShape); public class function Make(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList): TmsShape; override; class function IsNeedsSecondClick: Boolean; override; procedure EndTo(const aFinishPoint: TPointF); override; end; // TmsMover implementation uses msRectangle, FMX.Types, System.SysUtils; constructor TmsMover.Create(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList; aMoving: TmsShape); begin inherited Create(aStartPoint); f_ListWithOtherShapes := aListWithOtherShapes; f_Moving := aMoving; end; class function TmsMover.Make(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList): TmsShape; var l_Moving: TmsShape; begin l_Moving := ShapeByPt(aStartPoint, aListWithOtherShapes); if (l_Moving <> nil) then Result := Create(aStartPoint, aListWithOtherShapes, l_Moving) else Result := nil; end; class function TmsMover.IsNeedsSecondClick: Boolean; begin Result := true; end; procedure TmsMover.EndTo(const aFinishPoint: TPointF); begin if (f_Moving <> nil) then f_Moving.MoveTo(aFinishPoint); f_ListWithOtherShapes.Remove(Self); // - , , end; procedure TmsMover.DoDrawTo(const aCtx: TmsDrawContext); var l_Ctx: TmsDrawContext; begin if (f_Moving <> nil) then begin l_Ctx := aCtx; l_Ctx.rMoving := true; f_Moving.DrawTo(l_Ctx); end; // f_Moving <> nil end; initialization TmsMover.Register; end.
procedure TmsDiagramm.BeginShape(const aStart: TPointF); begin Assert(CurrentClass <> nil); FCurrentAddedShape := CurrentClass.Make(aStart, FShapeList); if (FCurrentAddedShape <> nil) then begin FShapeList.Add(FCurrentAddedShape); if not FCurrentAddedShape.IsNeedsSecondClick then // - SecondClick, - FCurrentAddedShape := nil; Invalidate; end; // FCurrentAddedShape <> nil end; procedure TmsDiagramm.EndShape(const aFinish: TPointF); begin Assert(CurrentAddedShape <> nil); CurrentAddedShape.EndTo(aFinish); FCurrentAddedShape := nil; Invalidate; end;
procedure TmsMover.EndTo(const aFinishPoint: TPointF); begin if (f_Moving <> nil) then f_Moving.MoveTo(aFinishPoint); f_ListWithOtherShapes.Remove(Self); // - , end;
procedure TmsShape.MoveTo(const aFinishPoint: TPointF); begin FStartPoint := aFinishPoint; end;
type TmsShapeByPt = function (const aPoint: TPointF): TmsShape of object; ... class function Make(const aStartPoint: TPointF; aShapeByPt: TmsShapeByPt): TmsShape; override; ... procedure TmsDiagramm.BeginShape(const aStart: TPointF); begin Assert(CurrentClass <> nil); // FCurrentAddedShape := CurrentClass.Make(aStart, Self.ShapeByPt); if (FCurrentAddedShape <> nil) then begin FShapeList.Add(FCurrentAddedShape); if not FCurrentAddedShape.IsNeedsSecondClick then // - SecondClick, - FCurrentAddedShape := nil; Invalidate; end;//FCurrentAddedShape <> nil end;
type TmsMakeShapeContext = record public rStartPoint: TPointF; rShapeByPt: TmsShapeByPt; constructor Create(aStartPoint: TPointF; aShapeByPt: TmsShapeByPt); end;//TmsMakeShapeContext
type TmsInterfacedNonRefcounted = class abstract(TObject) protected function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; end;//TmsInterfacedNonRefcounted TmsShape = class; ImsShapeByPt = interface function ShapeByPt(const aPoint: TPointF): TmsShape; end;//ImsShapeByPt ImsShapesController = interface procedure RemoveShape(aShape: TmsShape); end;//ImsShapeRemover
type TmsMakeShapeContext = record public rStartPoint: TPointF; rShapesController: ImsShapesController; constructor Create(aStartPoint: TPointF; const aShapesController: ImsShapesController); end; // TmsMakeShapeContext
FCurrentAddedShape := CurrentClass.Make(aStart, Self.ShapeByPt);
FCurrentAddedShape := CurrentClass.Make(TmsMakeShapeContext.Create(aStart, Self));
procedure TmsMover.EndTo(const aCtx: TmsEndShapeContext); begin if (f_Moving <> nil) then f_Moving.MoveTo(aCtx.rStartPoint); f_Moving := nil; aCtx.rShapesController.RemoveShape(Self); // - end;
function TmsTriangle.FillColor: TAlphaColor; begin Result := TAlphaColorRec.Green; end;
type TmsDrawOptionsContext = record public rFillColor: TAlphaColor; rStrokeDash: TStrokeDash; rStrokeColor: TAlphaColor; rStrokeThickness: Single; constructor Create(const aCtx: TmsDrawContext); end;//TmsDrawOptionsContext
procedure TmsTriangle.TransformDrawOptionsContext(var theCtx: TmsDrawOptionsContext); begin inherited; theCtx.rFillColor := TAlphaColorRec.Green; theCtx.rStrokeColor := TAlphaColorRec.Blue; end;
constructor TmsDrawOptionsContext.Create(const aCtx: TmsDrawContext); begin rFillColor := TAlphaColorRec.Null; if aCtx.rMoving then begin rStrokeDash := TStrokeDash.sdDashDot; rStrokeColor := TAlphaColors.Darkmagenta; rStrokeThickness := 4; end // aCtx.rMoving else begin rStrokeDash := TStrokeDash.sdSolid; rStrokeColor := TAlphaColorRec.Black; rStrokeThickness := 1; end; // aCtx.rMoving end;
procedure TmsShape.DrawTo(const aCtx: TmsDrawContext); var l_Ctx: TmsDrawOptionsContext; begin l_Ctx := DrawOptionsContext(aCtx); aCtx.rCanvas.Fill.Color := l_Ctx.rFillColor; aCtx.rCanvas.Stroke.Dash := l_Ctx.rStrokeDash; aCtx.rCanvas.Stroke.Color := l_Ctx.rStrokeColor; aCtx.rCanvas.Stroke.Thickness := l_Ctx.rStrokeThickness; DoDrawTo(aCtx); end; function TmsShape.DrawOptionsContext(const aCtx: TmsDrawContext): TmsDrawOptionsContext; begin Result := TmsDrawOptionsContext.Create(aCtx); // TransformDrawOptionsContext(Result); end;
unit msOurShapes; interface uses msLine, msRectangle, msCircle, msRoundedRectangle, msUseCaseLikeEllipse, msTriangle, msDashDotLine, msDashLine, msDotLine, msLineWithArrow, msTriangleDirectionRight, msMover, msRegisteredShapes ; implementation procedure RegisterOurShapes; begin TmsRegisteredShapes.Instance.Register([ TmsLine, TmsRectangle, TmsCircle, TmsRoundedRectangle, TmsUseCaseLikeEllipse, TmsTriangle, TmsDashDotLine, TmsDashLine, TmsDotLine, TmsLineWithArrow, TmsTriangleDirectionRight, TmsMover ]); end; initialization RegisterOurShapes; end.
procedure TmsRegisteredShapes.Register(const aShapes: array of RmsShape); var l_Index: Integer; begin for l_Index := Low(aShapes) to High(aShapes) do Self.Register(aShapes[l_Index]); end; procedure TmsRegisteredShapes.Register(const aValue: RmsShape); begin Assert(f_Registered.IndexOf(aValue) < 0); f_Registered.Add(aValue); end;
Source: https://habr.com/ru/post/234801/
All Articles