📜 ⬆️ ⬇️

MindStream. How do we write software under FireMonkey. Part 2

Part 1 .

Hello.

In this article I will continue the story about how we write under FireMonkey. 2 interesting objects will be added. Both will remind us of vector algebra and trigonometry. Also in the post will be shown techniques from the PLO, which we use.
')

A number of lines (differing only in dotted line, dot-dash, point-to-point, etc), which we added, were made by analogy with the description of the previous primitives. Now is the time to move to more complex shapes (including composite ones).

The first primitive that we add will be a line with an arrow (an arrow will draw a regular triangle, but smaller sizes).

To begin, we introduce a triangle that "looks to the right." To do this, we will inherit the usual triangle and rewrite the Polygon method, which is responsible for the coordinates of the vertices.

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; 


Here are our triangles:



Next, inherit the so-called "small triangle":
 type TmsSmallTriangle = class(TmsTriangleDirectionRight) protected function FillColor: TAlphaColor; override; public class function InitialHeight: Single; override; end; // TmsSmallTriangle 


As we see, all that we have done is to redefine the functions unique to the new triangle.

The next class will add a line with an arrow, which we will inherit from the usual line. The class will override only the procedure for drawing the primitive itself, that is, the line will draw the base class, but the triangle will inherit.

 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; 


There is nothing special to analyze here, everything is already indicated in the comments, but for those who want to remember what vector algebra is and how it works with vector graphics (moving, rotating various shapes, etc.), I recommend a wonderful post on Habré on this topic, but There are also vectors for dummies. Actions with vectors. Coordinates of the vector. The simplest problems with vectors ” and “ Linear dependence and linear independence of vectors. The basis of vectors. Affine coordinate system " .

As you can see from the picture, our triangle is currently drawn only when we draw a line from left to right:



Further the task becomes more interesting. We need to rotate the triangle, right perpendicular to the line that drew it. To do this, we introduce the GetArrowAngleRotation method, which will calculate the rotation angle.
To do this, imagine that our line is the hypotenuse of a right triangle; then we find the angle with the leg, which will be the angle of rotation of the triangle relative to the line:



 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; 

Now our line looks like this:


The next object we add will be responsible for moving the shapes.

The algorithm that we use:
1. We need a method to determine if a point hits a specific figure, say, ContainsPt, for each figure; since the formulas for calculating the hit for each figure are unique, we use virtual functions.
2. We need the following method to determine which piece we hit, if they intersect. Since the figures fall into the list as they appear on the form, for the case of the intersection of the figures, that of the figures that is at the top of the list is the last one that appears, respectively, "above". In fact, there is a puncture in this logic, but for the time being we’ll decide that this is correct and leave corrections for the next post.
3. When you first click on a shape that you hit, we must change its outline or a number of other characteristics.
4. With the second click, we have to move the shape that we hit.

The relocation class itself will be inherited from the standard shape, but it will keep in itself the shape that it moves, and it was he who, with the second click (in the last post I described what the line drawing feature) will redraw the shape.

We implement the methods that I described.
1. The method determines whether a point falls into a shape (in our case, a rectangle):

 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; 

2. When pressed, this method answers our question - what kind of figure did we hit:
 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; 


3. When you first click on a shape that you hit, we must change its outline or a number of other characteristics.
To implement the following method we will do a little refactoring. We introduce the so-called “drawing context”:

 type TmsDrawContext = record public rCanvas: TCanvas; rOrigin: TPointF; rMoving: Boolean; // - ,     -  constructor Create(const aCanvas: TCanvas; const aOrigin: TPointF); end; // TmsDrawContext 

If we indicate to the figure in the context of drawing that it is “moved”, then drawing will be different.
 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; 



4. With the second click, we have to move the shape that we hit.
To begin with, we introduce a factory method that is responsible for building the shape (we need a list of shapes so that TmsMover can refer to all the shapes that are drawn within the current chart).

 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; 


Through the use of the class function, we fundamentally divided the creation of the object of movement and all the other figures. However, this approach has a negative side. For example, we entered the creation parameter aListWithOtherShapes, which is completely unnecessary for other figures.

 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. 



In the controller, we only need to change the methods for creating shapes:

 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; 


Calling CurrentAddedShape.EndTo (aFinish) in the case of a mover will cause MoveTo, that is, move the shape; redrawing, as seen above, is initiated by the controller:

 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; 


Since the controller is responsible for the logic of the behavior of the figures, we will move the checkout method “hitting the figure” to the controller, and when creating objects we will transfer the check function:

 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; 


Since it is necessary to transfer 2 parameters to create objects, we create a “creation” context:

 type TmsMakeShapeContext = record public rStartPoint: TPointF; rShapeByPt: TmsShapeByPt; constructor Create(aStartPoint: TPointF; aShapeByPt: TmsShapeByPt); end;//TmsMakeShapeContext 


Add the interfaces that the controller will implement, and also add the class of the interface object. In the future, we will implement our own reference counting in it.

 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 


Change the TmsMakeShapeContext slightly:
 type TmsMakeShapeContext = record public rStartPoint: TPointF; rShapesController: ImsShapesController; constructor Create(aStartPoint: TPointF; const aShapesController: ImsShapesController); end; // TmsMakeShapeContext 


In more detail about interfaces and features of working with them in Delphi I recommend 2 interesting posts:

18delphi.blogspot.com/2013/04/iunknown.html
habrahabr.ru/post/181107

Let's make our controller (TmsDiagramm) inherited from TmsInterfacedNonRefcounted and interfaces and change one line in the BeginShape method.
It was:
  FCurrentAddedShape := CurrentClass.Make(aStart, Self.ShapeByPt); 

It became:
  FCurrentAddedShape := CurrentClass.Make(TmsMakeShapeContext.Create(aStart, Self)); 


In the case of a move, the EndTo method, which is called in a mover, will look like this:

 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; 


In the last post, I talked about how we hid “unique settings” (fill color, thickness of lines, etc.) in virtual methods that each figure sets by itself. For example:

 function TmsTriangle.FillColor: TAlphaColor; begin Result := TAlphaColorRec.Green; end; 


All figure settings are “packaged” in context:

 type TmsDrawOptionsContext = record public rFillColor: TAlphaColor; rStrokeDash: TStrokeDash; rStrokeColor: TAlphaColor; rStrokeThickness: Single; constructor Create(const aCtx: TmsDrawContext); end;//TmsDrawOptionsContext 


In the TmsShape class, we do a virtual procedure by analogy with the previous example. In the future, we will easily expand the number of settings unique to the shape:

 procedure TmsTriangle.TransformDrawOptionsContext(var theCtx: TmsDrawOptionsContext); begin inherited; theCtx.rFillColor := TAlphaColorRec.Green; theCtx.rStrokeColor := TAlphaColorRec.Blue; end; 


Thanks to the context, we remove the logic (do we draw mover?) From the drawing method and hide it in the record constructor:

 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; 


After that, our method for drawing will look like this:

 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; 


All that is left for us to move our objects is to write a ContainsPt method for each piece, which will check if a point has fallen into a shape. Regular trigonometry, all the formulas are on the Internet.




Slightly remake the registration of objects in the container. Now each class "registers" itself. We take out the registration in a separate module.

 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. 


In the container we will add the registration method:

 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; 




Link to the repository.

In this post, we tried to show how, through the use of contexts, interfaces and the factory method, make your life easier. More details about the factory method can be found here and here .

In the next post we will tell about how we "screwed" DUnit to FireMonkey. And we will write several tests, some of which will immediately cause an error.

Part 3
Part 3.1

Source: https://habr.com/ru/post/234801/


All Articles