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_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, 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);
  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 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);
 // Собственно сам вызов
 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 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 _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


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);
  f_Registered.Add(aValue);
end;




Link to the repository.

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

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

Part 3 .
Part 3.1

Also popular now: