# MindStream. As we write software under FireMonkey. Part 2

• Tutorial
Part 1 .

Hello.

In this article, I will continue the story of how we write under FireMonkey. 2 interesting objects will be added. Both will remind us of vector algebra and trigonometry. Also, the post will show the techniques from the OOP that we use.

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

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

First, we introduce a triangle that "looks to the right." To do this, we will inherit a regular 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;
``````

This is what our triangles look like:

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

As you can see, all we did was redefine the functions unique to the new triangle.

In the next class, add a line with an arrow, which we will inherit from a regular line. Only the drawing procedure of the primitive itself will be redefined in the class, that is, the base class will draw the line, but the triangle is the heir.

``````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_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, however, for those wishing to remember what vector algebra is and how vector graphics are handled (moving, rotating various shapes, etc.), I recommend a wonderful post on Habré on this subject, and also the article “Vectors for Dummies. Actions with vectors. Vector coordinates. The simplest problems with vectors ” and “ Linear dependence and linear independence of vectors. The basis of vectors. Affine coordinate system " .

As we 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 angle of rotation.
To do this, imagine that our line is the hypotenuse of a right triangle; Next, 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 that we add will be responsible for moving the shapes.

The algorithm that we will 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. The next method is necessary for us to determine which figure we are in if they intersect. Since the figures are included in the list as they appear on the form, for the case of intersection of the figures, that of the figures that is at the top of the list is the last to appear, respectively, lies "on top". In fact, there is a puncture in this logic, but for now, let's decide that this is correct, and leave the corrections for the next post.
3. The first time you click on the shape you hit, we must change its outline or a number of other characteristics.
4. The second time we press, we must move the shape we hit.

The move class itself will be inherited from the standard shape, but it will store the shape that it moves in itself, and it will be he who redraws the shape during the second click (in the last post I described what the feature of line drawing is).

We implement the methods that I described.
1. The method determines whether a point falls into the 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. This method, when clicked, answers, we are asked the question - which figure we got into:
``````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. The first time you click on the shape 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 “movable”, then the drawing will occur differently.
``````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. The second time we press, we must move the shape we hit.
First, we introduce the factory method that is responsible for building the figure (we need a list of shapes in order for TmsMover to be able to access all the figures 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;
``````

Thanks to the use of the class function, we fundamentally divided the creation of the displacement object and all other figures. However, this approach has a negative side. For example, we introduced the option to create aListWithOtherShapes, which other shapes do not need at all.

``````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);
begin
// - если не надо SecondClick, то наш примитив - завершён
Invalidate;
end;
procedure TmsDiagramm.EndShape(const aFinish: TPointF);
begin
Invalidate;
end;
``````

Calling CurrentAddedShape.EndTo (aFinish) in the case of a mover will call MoveTo, that is, move the figure; 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 issue a method for checking "getting into the figure" in the controller, and when creating objects, we will transfer the verification 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);
// Собственно сам вызов
begin
// - если не надо SecondClick, то наш примитив - завершён
Invalidate;
end;
``````

Since 2 parameters must be passed to create objects, we create the “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 interface object class. 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 _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
``````

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

In more detail about the interfaces and the 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 in the interface and BeginShape one line.
It was:
``````  FCurrentAddedShape := CurrentClass.Make(aStart, Self.ShapeByPt);
``````

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

In the case of a move, the EndTo method that is called on the mover will take the following form:

``````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, line thickness, etc.) in virtual methods that each figure sets independently. For instance:

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

All settings of the figures are “packaged” into the 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 make a virtual procedure by analogy with the previous example. In the future, we will easily expand the number of settings unique to the figure:

``````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 the mover?) From the drawing method and hide it in the recording 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 which, our drawing method 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 the ContainsPt method to each figure, which will check if a point has hit the figure. Ordinary trigonometry, all formulas are on the Internet.

Slightly redo the registration of objects in the container. Now each class "registers" itself. We will register 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, 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);
end;
``````