MindStream. Как мы пишем ПО под FireMonkey

Месяц назад мы решили написать кросс-платформенное приложение, используя FireMonkey. В качестве направления выбрали рисование графических примитивов, с возможностью сохранения и восстановления данных.

Процесс написания приложения мы договорились подробно описывать на Хабре.

В статьях будет показано на практике использования различных техник, таких как: Dependency Injection, фабричный метод, использование контекстов, использование контроллеров и т.д. В ближайшем будущем планируется прикрутить туда тесты Dunit. DUnit’a в данный момент нет для FMX, так что придётся что-то придумывать самим.

Начнем мы с рабочего прототипа который к моменту окончания статьи приобретет такой вид:

Для начала научим программу рисовать на Canvas’e. Первые примитивы которые мы добавим в программу, будут прямоугольник и линия.

Для этого расположим на форме объект TImage, а также добавим создание Bitmap:

procedure TfmMain.FormCreate(Sender: TObject);
begin
 imgMain.Bitmap := TBitmap.Create(400, 400);
 imgMain.Bitmap.Clear(TAlphaColorRec.White);
end;

Процедура для рисования прямоугольника:

procedure TfmMain.btnRectClick(Sender: TObject);
begin
 imgMain.Bitmap.Canvas.BeginScene;
 imgMain.Bitmap.Canvas.DrawRect(TRectF.Create(10, 10, 200, 270),
                                30, 60,
                                AllCorners, 100,
                                TCornerType.ctRound);
 imgMain.Bitmap.Canvas.EndScene;
end;

Для линии всё ещё проще:

 ImgMain.Bitmap.Canvas.BeginScene;
 ImgMain.Bitmap.Canvas.DrawLine(FStartPos, TPointF.Create(X, Y), 1);
 ImgMain.Bitmap.Canvas.EndScene;

Следующим шагом выделим класс для фигур TMyShape от которого унаследуем наши фигуры TLine и TRectangle:

type 
 TMyShape = class
 private
  FStartPoint, FFinalPoint: TPointF;
 public
  Constructor Create(aStartPoint, aFinalPoint: TPointF); overload;
  procedure DrawTo(aCanvas : TCanvas);
  procedure DrawShape(aCanvas : TCanvas); virtual; abstract;
 end;

 TLine = class(TMyShape)
 private
   procedure DrawShape(aCanvas : TCanvas); override;
 end;

 TRectangle = class(TMyShape)
 private
   procedure DrawShape(aCanvas : TCanvas); override;
 end;

procedure TMyShape.DrawTo(aCanvas: TCanvas);
begin
  aCanvas.BeginScene;
  DrawShape(aCanvas);
  aCanvas.EndScene;
end;

Как видим метод DrawTo отвечает за подготовку холста к рисованию и вызывает виртуальный метод рисования для каждой фигуры.

Создадим класс TDrawness отвечающий за хранение всех фигур, и их рисование:

type
 TDrawness = class
 private
  FShapeList : TObjectList<TMyShape>;
    function GetShapeList: TObjectList<TMyShape>;
 public
  constructor Create;
  destructor Destroy; override;
  procedure DrawTo(aCanvas : TCanvas);
 property ShapeList : TObjectList<TMyShape> read GetShapeList;
 end;

Процедура DrawTo пробегает по всему списку и вызывает соответствующий метод для каждого объекта:

procedure TDrawness.DrawTo(aCanvas: TCanvas);
var
 i : Integer;
begin
 for i:= 0 to FShapeList.Count-1
  do FShapeList[i].DrawTo(aCanvas);
end;

То есть, теперь, каждая фигура которую мы хотим запомнить, должна быть добавлена в Drawness. Например код создания прямоугольника становиться следующим:

procedure TfmMain.btnRectClick(Sender: TObject);
var
 l_StartPoint, l_FinalPoint: TPointF;
begin
 l_StartPoint := TPointF.Create(StrToFloat(edtStartPointX.Text),
                                StrToFloat(edtStartPointY.Text));
 l_FinalPoint := TPointF.Create(StrToFloat(edtFinalPointX.Text),
                                StrToFloat(edtFinalPointY.Text));
 FDrawness.ShapeList.Add(TRectangle.Create(l_StartPoint, l_FinalPoint));
 FDrawness.ShapeList.Last.DrawTo(imgMain.Bitmap.Canvas);
end;

Последняя строчка в методе необходима нам для того что бы нарисовать только что добавленную фигуру.

Для рисования линий добавим маленький круг, который будет рисоваться в начальной и конечной точке линии:

type
 TmsPointCircle= class(TMyShape)
 private
   procedure DrawShape(const aCanvas : TCanvas); override;
 end;

procedure TmsPointCircle.DrawShape(const aCanvas: TCanvas);
var
 l_StartPoint, l_FinalPoint: TPointF;
begin
 l_StartPoint.X := FStartPoint.X - 15;
 l_StartPoint.Y := FStartPoint.Y - 15;

 l_FinalPoint.X := FStartPoint.X + 15;
 l_FinalPoint.Y := FStartPoint.Y + 15;

 aCanvas.DrawEllipse(TRectF.Create(l_StartPoint, l_FinalPoint), 1);
end;

Следующим шагом необходимо научиться добавлять линии только по второму нажатию мышки, делаем пока в лоб:

procedure TfmMain.imgMainMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
 FPressed := True;
 FStartPos := TPointF.Create(X, Y);

 if FIsFirstClick then
  FIsFirstClick := False
 else
 begin
  FDrawness.ShapeList.Add(TLine.Create(FStartPos, FLastPoint));
  FDrawness.ShapeList.Last.DrawTo(imgMain.Bitmap.Canvas);

  FIsFirstClick := True;
 end;

 FLastPoint := TPointF.Create(X, Y);

 FDrawness.ShapeList.Add(TmsPointCircle.Create(FStartPos, FLastPoint));
 FDrawness.ShapeList.Last.DrawTo(imgMain.Bitmap.Canvas);
end;

Сделаем небольшой рефакторинг и добавим в класс TDrawness метод AddPrimitive:

procedure TmsDrawness.AddPrimitive(const aShape: TmsShape);
begin
 FShapeList.Add(aShape);
end;

А вот тут мы применим Dependency Injection. Создадим контейнер который будет хранить все типы наших фигур. Для этого воспользуемся списком метакласса TmsShape. Сам контейнер сделаем Singleton’ом, так как список типов наших фигур нам нужен в единственном экземпляре и добавим туда метод AddPrimitive.

unit msRegisteredPrimitives;

interface

uses
 msShape, Generics.Collections;

type
 RmsShape = class of TmsShape;

 TmsRegistered = TList<RmsShape>;

 TmsRegisteredPrimitives  = class
 strict private
  FmsRegistered : TmsRegistered;
  class var FInstance: TmsRegisteredPrimitives;
  constructor Create;
 public
  class function GetInstance: TmsRegisteredPrimitives;
  procedure AddPrimitive(const Value : RmsShape);
 end;


implementation

procedure TmsRegisteredPrimitives.AddPrimitive(const Value: RmsShape);
begin
 FmsRegistered.Add(Value);
end;

constructor TmsRegisteredPrimitives.Create;
 begin
  inherited;
 end;

 class function TmsRegisteredPrimitives.GetInstance: TmsRegisteredPrimitives;
 begin
  If FInstance = nil Then
  begin
   FInstance := TmsRegisteredPrimitives.Create();
  end;
  Result := FInstance;
 end;

end.

Инъекцией будет служить регистрация каждого класса унаследованного от TMsShape.

initialization
 TmsRegisteredPrimitives.GetInstance.AddPrimitive(TmsLine);
 TmsRegisteredPrimitives.GetInstance.AddPrimitive(TmsRectangle);
end.

Заносим(на FormCreate) список наших примитивов в ComboBox дабы удобнее было их вызывать:

for i := 0 to TmsRegisteredPrimitives.GetInstance.PrimitivesCount-1 do
  cbbPrimitives.Items.AddObject(TmsRegisteredPrimitives.GetInstance.Primitives[i].ClassName,
                                TObject(TmsRegisteredPrimitives.GetInstance.Primitives[i]));

Теперь, путем простейшей операции мы можем создавать тот примитив который выбран в ComboBox:

FDrawness.AddPrimitive(RmsShape(cbbPrimitives.items.Objects[cbbPrimitives.ItemIndex]).Create(TPointF.Create(X,Y),TPointF.Create(X+100,Y+100)));

Объекту TmsShape добавляем классовый метод IsNeedsSecondClick. Который мы будем переопределять в потомках. Для линий True, для всех остальных False.

Добавим в TmsDrawness новое поле, которое будет отвечать за выбранный класс в ComboBox’e:

 property CurrentClass : RmsShape read FCurrentClass write FCurrentClass;

В связи с чем добавим в ComboBox.OnChange:

 FDrawness.CurrentClass := RmsShape(cbbPrimitives.items.Objects[cbbPrimitives.ItemIndex]);

Перепишем добавление фигуры в Drawness:

 ShapeObject := FDrawness.CurrentClass.Create(FStartPos, FLastPoint);
 FDrawness.AddPrimitive(ShapeObject);

Так как Drawness отвечает за рисование всех фигур, добавим ему метод очистки Canvas’a:

procedure TmsDrawness.Clear(const aCanvas: TCanvas);
begin
 aCanvas.BeginScene;
 aCanvas.Clear(TAlphaColorRec.Null);
 aCanvas.EndScene;
end;

И перепишем процедуру рисования. Будем перед началом рисования будем очищать Canvas, а потом рисовать все объекты, которые находятся в Drawness.List.

procedure TmsDrawness.DrawTo(const aCanvas: TCanvas; const aOrigin : TPointF);
var
 i : Integer;
begin
 Clear(aCanvas);

 for i:= 0 to FShapeList.Count-1
  do FShapeList[i].DrawTo(aCanvas, aOrigin);
end;

Так как мы убедились в работе прототипа, пора приниматься за рефакторинг, и собственно строить архитектуру приложения.

Для начала перенесем создание объекта в метод TDrawness.AddPrimitive и перестанем создавать его на форме.

procedure TmsDrawness.AddPrimitive(const aStart: TPointF; const aFinish: TPointF);
begin
 Assert(CurrentClass <> nil);
 FShapeList.Add(CurrentClass.Create(aStart, aFinish));
end;

Следующим шагом, изменим алгоритм создания и добавления новой фигуры. Вместо того что бы сразу добавлять примитив в список, введём промежуточный объект типа TmsShape. Код добавления примитива теперь выглядит так:

procedure TmsDrawness.AddPrimitive(const aStart: TPointF; const aFinish: TPointF);
begin
 Assert(CurrentClass <> nil);
 FCurrentAddedShape := CurrentClass.Create(aStart, aFinish);
 FShapeList.Add(FCurrentAddedShape);
end;

Дальше сделаем обработку текущего класса, нужен ли этому классу второй клик мыши для рисования.

procedure TmsDrawness.AddPrimitive(const aStart: TPointF; const aFinish: TPointF);
begin
 Assert(CurrentClass <> nil);
 FCurrentAddedShape := CurrentClass.Create(aStart, aFinish);
 FShapeList.Add(FCurrentAddedShape);
 if not FCurrentAddedShape.IsNeedsSecondClick then
 // - если не надо SecondClick, то наш примитив - завершён
  FCurrentAddedShape := nil;
end;

В тоже время изменим добавление примитивов на форме:

procedure TfmMain.imgMainMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
var
 l_StartPoint : TPointF;
begin
 l_StartPoint := TPointF.Create(X, Y);

 if (FDrawness.CurrentAddedShape = nil) then
 // - мы НЕ ДОБАВЛЯЛИ примитива - надо его ДОБАВИТЬ
  FDrawness.AddPrimitive(l_StartPoint, l_StartPoint)
 else
  FDrawness.FinalizeCurrentShape(l_StartPoint);

 FDrawness.DrawTo(imgMain.Bitmap.Canvas, FOrigin);
end;

Итак что же у нас получилось.
Если нам необходимо нарисовать линию, наш CurrentAddedShape равен nil на первом клике. Поэтому мы добавляем примитив с одинаковыми точками начала и конца отрезка.

Далее в FDrawness.AddPrimitive мы проверяем текущий класс и так как(в случае с линией) ему нужен второй клик мы ничего не делаем.

После чего перерисовываем все объекты. Сейчас у нас ничего не на рисуется так как линия с одинаковой начальной и конечной точкой просто не рисуется.

Когда пользователь нажмет второй раз мышкой, мы опять проверим CurrentAddedShape, и так как мы его не освобождали, то вызовем метод финализации фигуры, где установим вторую точку линии, и освободим наш буферный объект:

procedure TmsDrawness.FinalizeCurrentShape(const aFinish: TPointF);
begin
  Assert(CurrentAddedShape <> nil);
  CurrentAddedShape.FinalPoint := aFinish;
  FCurrentAddedShape := nil;
end;

И опять перерисовываем все фигуры.

Для остальных фигур, в FDrawness.AddPrimitive после добавления фигуры в список, мы сразу освобождаем наш “буфер”.

После небольшого рефакторинга(более вменяемо назовем наши методы, и перенесем обработку нажатий мышки в Drawness) у нас получится такая картина:

procedure TmsDiagramm.ProcessClick(const aStart: TPointF);
begin
 if ShapeIsEnded then
 // - мы НЕ ДОБАВЛЯЛИ примитива - надо его ДОБАВИТЬ
  BeginShape(aStart)
 else
  EndShape(aStart);
end;

function TmsDiagramm.ShapeIsEnded: Boolean;
begin
 Result := (CurrentAddedShape = nil);
end;

procedure TmsDiagramm.BeginShape(const aStart: TPointF);
begin
 Assert(CurrentClass <> nil);
 FCurrentAddedShape := CurrentClass.Create(aStart, aStart);
 FShapeList.Add(FCurrentAddedShape);
 if not FCurrentAddedShape.IsNeedsSecondClick then
 // - если не надо SecondClick, то наш примитив - завершён
  FCurrentAddedShape := nil;
 Invalidate;
end;

procedure TmsDiagramm.EndShape(const aFinish: TPointF);
begin
 Assert(CurrentAddedShape <> nil);
 CurrentAddedShape.EndTo(aFinish);
 FCurrentAddedShape := nil;
 Invalidate;
end;

procedure TmsDiagramm.Invalidate;
begin
 Clear;
 DrawTo(FCanvas, FOrigin);
end;

Так как TDrawness уже по сути является контролером рисования, то его обязанность подготавливать Canvas к рисованию, заодно используем enumerator:

procedure TmsDrawness.DrawTo(const aCanvas: TCanvas; const aOrigin : TPointF);
var
 l_Shape : TmsShape;
begin
 aCanvas.BeginScene;
 try
  for l_Shape in FShapeList do
   l_Shape.DrawTo(aCanvas, aOrigin);
 finally
  aCanvas.EndScene;
 end;//try..finally
end;

При рисовании линии, рисуем круг на месте первого нажатия:

procedure TmsLine.DrawTo(const aCanvas : TCanvas; const aOrigin : TPointF);
var
 l_Proxy : TmsShape;
begin
 if (StartPoint = FinishPoint) then
 begin
  l_Proxy := TmsPointCircle.Create(StartPoint, StartPoint);
  try
   l_Proxy.DrawTo(aCanvas, aOrigin);
  finally
   FreeAndNil(l_Proxy);
  end;//try..finally
 end//StartPoint = FinishPoint
 else
  aCanvas.DrawLine(StartPoint.Add(aOrigin),
                   FinishPoint.Add(aOrigin), 1);
end;

Как видите мы создаем и рисуем маленький кружок, однако мы не добавляем его в список примитивов в Drawness поэтому при нажатии второй раз мышкой, наш холст будет перерисован, и круга уже не будет.

Добавляем новую фигуру — круг:

type
 TmsCircle = class(TmsShape)
 protected
  procedure DrawShape(const aCanvas : TCanvas; const aOrigin : TPointF); override;
 public
  class function IsNeedsSecondClick : Boolean; override;
 end;

implementation

const
 c_CircleRadius = 50;

{ TmsCircle }

procedure TmsCircle.DrawShape(const aCanvas: TCanvas; const aOrigin : TPointF);
var
 l_StartPoint, l_FinalPoint: TPointF;
begin
 l_StartPoint.X := FStartPoint.X - c_CircleRadius;
 l_StartPoint.Y := FStartPoint.Y - c_CircleRadius;

 l_FinalPoint.X := FStartPoint.X + c_CircleRadius;
 l_FinalPoint.Y := FStartPoint.Y + c_CircleRadius;

 aCanvas.DrawEllipse(TRectF.Create(l_StartPoint.Add(aOrigin),
                                   l_FinalPoint.Add(aOrigin)), 1);
end;

class function TmsCircle.IsNeedsSecondClick: Boolean;
begin
 Result := False;
end;

end.

В классе круга заменяем константу на вызов виртуального метода:

class function TmsCircle.Radius: Integer;
begin
 Result := 50;
end;

В следствии чего, в класс для маленького круга нам необходимо лишь переопределить метод Radius:

type
 TmsPointCircle = class(TmsCircle)
 protected
  class function Radius: Integer; override;
 end;

implementation

{ TmsPointCircle }

class function TmsPointCircle.Radius: Integer;
begin
 Result := 10;
end;

end.

Доделываем наш Dependency Injection. Переносим регистрацию классов из контейнера в каждый класс. И добавляем в TmsShape новый метод Register. Также объявляем его абстрактным:

Класс TmsShape теперь выглядит так:

type
 TmsShape = class abstract (TObject)
 private
  FStartPoint: TPointF;
  FFinishPoint: TPointF;
 protected
  property StartPoint : TPointF read FStartPoint;
  property FinishPoint : TPointF read FFinishPoint;
  class procedure Register;
 public
  constructor Create(const aStartPoint, aFinishPoint: TPointF); virtual;
  procedure DrawTo(const aCanvas : TCanvas; const aOrigin : TPointF); virtual; abstract;
  class function IsNeedsSecondClick : Boolean; virtual;
  procedure EndTo(const aFinishPoint: TPointF);
 end;

implementation

uses
  msRegisteredPrimitives
  ;

class procedure TmsShape.Register;
begin
 TmsRegisteredPrimitives.Instance.AddPrimitive(Self);
end;

constructor TmsShape.Create(const aStartPoint, aFinishPoint: TPointF);
begin
 FStartPoint := aStartPoint;
 FFinishPoint := aFinishPoint;
end;

procedure TmsShape.EndTo(const aFinishPoint: TPointF);
begin
 FFinishPoint := aFinishPoint;
end;

class function TmsShape.IsNeedsSecondClick : Boolean;
begin
 Result := false;
end;

end.

А в каждом классе появилась строка о регистрации класса, например в классе TmsRectangle:

initialization
 TmsRectangle.Register;

Следующим примитивом добавим прямоугольник с закругленными краями:

type
 TmsRoundedRectangle = class(TmsRectangle)
 protected
  procedure DrawTo(const aCanvas : TCanvas; const aOrigin : TPointF); override;
 end;//TmsRoundedRectangle

implementation

procedure TmsRoundedRectangle.DrawTo(const aCanvas: TCanvas; const aOrigin : TPointF);
begin
 aCanvas.DrawRect(TRectF.Create(StartPoint.Add(aOrigin),
                                FinishPoint.Add(aOrigin)),
                  10, 10,
                  AllCorners, 1,
                  TCornerType.ctRound);
end;

initialization
 TmsRoundedRectangle.Register;

end.

И всё! Благодаря регистрации фигуры в контейнере, это весь код который нам необходим.
Ещё раз.
Нам надо унаследовать класс от любой фигуры, и переопределить метод рисования(Если необходимо).
Так как TmsShape — суперкласс, то в классовом методе Register будет добавлен непосредственно тот класс который регистрируется в контейнер.
Дальше у нас на FormCreate происходит занесение всех классов из контейнера в ComboBox.
И при выборе конкретной фигуры, отработают уже написанные механизмы.

Следующим шагом, благодаря наследованию и виртуальным функциям упростим рисование новой фигуры. В классе TmsRectangle введём классовый метод CornerRadius, и изменим рисование, заодно убрав магические числа.

class function TmsRectangle.CornerRadius: Single;
begin
 Result := 0;
end;

procedure TmsRectangle.DrawTo(const aCanvas: TCanvas; const aOrigin : TPointF);
begin
 aCanvas.DrawRect(TRectF.Create(StartPoint.Add(aOrigin),
                                FinishPoint.Add(aOrigin)),
                  CornerRadius,
                  CornerRadius,
                  AllCorners,
                  1,
                  TCornerType.ctRound);
end;

Теперь в нашем новом классе достаточно просто переписать метод CornerRadius с необходимым углом округления углов. Класс в целом выглядит так:

type
 TmsRoundedRectangle = class(TmsRectangle)
 protected
  class function CornerRadius: Single; override;
 end;//TmsRoundedRectangle

implementation

class function TmsRoundedRectangle.CornerRadius: Single;
begin
 Result := 10;
end;

initialization
 TmsRoundedRectangle.Register;

end.

Подобным способом избавляемся от констант. А так же добавим цвет заливки. Попробуем залить прямоугольник:

procedure TmsRectangle.DrawTo(const aCanvas: TCanvas; const aOrigin : TPointF);
begin
 aCanvas.Fill.Color := TAlphaColorRec.White;
 aCanvas.DrawRect(TRectF.Create(StartPoint.Add(aOrigin),
                                FinishPoint.Add(aOrigin)),
                  CornerRadius,
                  CornerRadius,
                  AllCorners,
                  1,
                  TCornerType.ctRound);
 aCanvas.FillRect(TRectF.Create(StartPoint.Add(aOrigin),
                                FinishPoint.Add(aOrigin)),
                  CornerRadius,
                  CornerRadius,
                  AllCorners,
                  1,
                  TCornerType.ctRound);
end;

Как видим для того что бы закрасить фигуру, необходимо установить цвет закраски холста. Таким образом что бы не дублировать код, и не добавлять новый параметр в метод рисования — мы воспользуемся виртуальным методом FillColor для TmsShape. А также перепишем метод рисования у супер класса.

Будем сначала устанавливать все необходимые параметры холсту, а уже потом вызывать виртуальный метод рисования каждой фигуры:

procedure TmsShape.DrawTo(const aCanvas : TCanvas; const aOrigin : TPointF);
begin
 aCanvas.Fill.Color := FillColor;
 DoDrawTo(aCanvas, aOrigin);
end;

Для добавления следующего примитива добавим виртуальных функций для круга:

type
 TmsCircle = class(TmsShape)
 protected
  class function InitialRadiusX: Integer; virtual;
  class function InitialRadiusY: Integer; virtual;
  function FillColor: TAlphaColor; override;
  procedure DoDrawTo(const aCanvas : TCanvas; const aOrigin : TPointF); override;
 public
  constructor Create(const aStartPoint, aFinishPoint: TPointF); override;
 end;

Следующим примитивом сделаем желтый овал:

type
 TmsUseCaseLikeEllipse = class(TmsCircle)
 protected
  class function InitialRadiusY: Integer; override;
  function FillColor: TAlphaColor; override;
 end;//TmsUseCaseLikeEllipse

implementation

class function TmsUseCaseLikeEllipse.InitialRadiusY: Integer;
begin
 Result := 35;
end;

function TmsUseCaseLikeEllipse.FillColor: TAlphaColor;
begin
 Result := TAlphaColorRec.Yellow;
end;

initialization
 TmsUseCaseLikeEllipse.Register;

end.

Добавим новый примитив — треугольник:

type
 TmsTriangle = class(TmsShape)
 protected
  function FillColor: TAlphaColor; override;
  procedure DoDrawTo(const aCanvas : TCanvas; const aOrigin : TPointF); override;
 end;//TmsTriangle

implementation

uses
 System.Math.Vectors
 ;

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

procedure TmsTriangle.DoDrawTo(const aCanvas: TCanvas; const aOrigin : TPointF);
const
 cHeight = 100;
var
 l_P : TPolygon;
begin
 SetLength(l_P, 4);
 l_P[0] := TPointF.Create(StartPoint.X - cHeight div 2,
                          StartPoint.Y + cHeight div 2);
 l_P[1] := TPointF.Create(StartPoint.X + cHeight div 2,
                          StartPoint.Y + cHeight div 2);
 l_P[2] := TPointF.Create(StartPoint.X,
                          StartPoint.Y - cHeight div 2);
 l_P[3] := l_P[0];
 aCanvas.DrawPolygon(l_P, 1);
 aCanvas.FillPolygon(l_P, 0.5);
end;

initialization
 TmsTriangle.Register;

end.

Как видим рисование треугольника несколько отличается от остальных фигур. Но всё равно делается весьма несложно. Тип TPolygon представляет собой динамический массив из TPointF. Заполняем его благодаря несложным расчетам, при всём при этом последняя точка полигона должна быть его первой точкой. Рисование же организовано стандартными методами.

Приведём в порядок названия классов. Класс TmsDrawness переименуем в TmsDiagramm. Также учитывая что все операции с Canvas выполняет класс Diagramm, то сделаем Canvas частью Diagramm.

Уберем из формы “лишние знания” и перенесем их в класс Diagramm, тем самым выделим полноценный контролер который отвечает за создания и рисование всех фигур нашего приложения.

type
 TmsDiagramm = class(TObject)
 private
  FShapeList : TmsShapeList;
  FCurrentClass : RmsShape;
  FCurrentAddedShape : TmsShape;
  FCanvas : TCanvas;
  FOrigin : TPointF;
 private
  procedure DrawTo(const aCanvas : TCanvas; const aOrigin : TPointF);
  function CurrentAddedShape: TmsShape;
  procedure BeginShape(const aStart: TPointF);
  procedure EndShape(const aFinish: TPointF);
  function ShapeIsEnded: Boolean;
  class function AllowedShapes: RmsShapeList;
  procedure CanvasChanged(aCanvas: TCanvas);
 public
  constructor Create(anImage: TImage);
  procedure ResizeTo(anImage: TImage);
  destructor Destroy; override;
  procedure ProcessClick(const aStart: TPointF);
  procedure Clear;
  property CurrentClass : RmsShape read FCurrentClass write FCurrentClass;
  procedure Invalidate;
  procedure AllowedShapesToList(aList: TStrings);
  procedure SelectShape(aList: TStrings; anIndex: Integer);
 end;

implementation

uses
 msRegisteredPrimitives
 ;

class function TmsDiagramm.AllowedShapes: RmsShapeList;
begin
 Result := TmsRegisteredPrimitives.Instance.Primitives;
end;

procedure TmsDiagramm.AllowedShapesToList(aList: TStrings);
var
 l_Class : RmsShape;
begin
 for l_Class in AllowedShapes do
  aList.AddObject(l_Class.ClassName, TObject(l_Class));
end;

procedure TmsDiagramm.SelectShape(aList: TStrings; anIndex: Integer);
begin
 CurrentClass := RmsShape(aList.Objects[anIndex]);
end;

procedure TmsDiagramm.ProcessClick(const aStart: TPointF);
begin
 if ShapeIsEnded then
 // - мы НЕ ДОБАВЛЯЛИ примитива - надо его ДОБАВИТЬ
  BeginShape(aStart)
 else
  EndShape(aStart);
end;

procedure TmsDiagramm.BeginShape(const aStart: TPointF);
begin
 Assert(CurrentClass <> nil);
 FCurrentAddedShape := CurrentClass.Create(aStart, aStart);
 FShapeList.Add(FCurrentAddedShape);
 if not FCurrentAddedShape.IsNeedsSecondClick then
 // - если не надо SecondClick, то наш примитив - завершён
  FCurrentAddedShape := nil;
 Invalidate;
end;

procedure TmsDiagramm.Clear;
begin
 FCanvas.BeginScene;
 try
  FCanvas.Clear(TAlphaColorRec.Null);
 finally
  FCanvas.EndScene;
 end;//try..finally
end;

constructor TmsDiagramm.Create(anImage: TImage);
begin
 FShapeList := TmsShapeList.Create;
 FCurrentAddedShape := nil;
 FCanvas := nil;
 FOrigin := TPointF.Create(0, 0);
 ResizeTo(anImage);
 FCurrentClass := AllowedShapes.First;
end;

procedure TmsDiagramm.ResizeTo(anImage: TImage);
begin
 anImage.Bitmap := TBitmap.Create(Round(anImage.Width), Round(anImage.Height));
 CanvasChanged(anImage.Bitmap.Canvas);
end;

procedure TmsDiagramm.CanvasChanged(aCanvas: TCanvas);
begin
 FCanvas := aCanvas;
 Invalidate;
end;

function TmsDiagramm.CurrentAddedShape: TmsShape;
begin
 Result := FCurrentAddedShape;
end;

destructor TmsDiagramm.Destroy;
begin
 FreeAndNil(FShapeList);
 inherited;
end;

procedure TmsDiagramm.DrawTo(const aCanvas: TCanvas; const aOrigin : TPointF);
var
 l_Shape : TmsShape;
begin
 aCanvas.BeginScene;
 try
  for l_Shape in FShapeList do
   l_Shape.DrawTo(aCanvas, aOrigin);
 finally
  aCanvas.EndScene;
 end;//try..finally
end;

procedure TmsDiagramm.EndShape(const aFinish: TPointF);
begin
 Assert(CurrentAddedShape <> nil);
 CurrentAddedShape.EndTo(aFinish);
 FCurrentAddedShape := nil;
 Invalidate;
end;

procedure TmsDiagramm.Invalidate;
begin
 Clear;
 DrawTo(FCanvas, FOrigin);
end;

function TmsDiagramm.ShapeIsEnded: Boolean;
begin
 Result := (CurrentAddedShape = nil);
end;

end.

Код формы теперь выглядит так:

var
 fmMain: TfmMain;

implementation

{$R *.fmx}

procedure TfmMain.btnClearImageClick(Sender: TObject);
begin
 FDiagramm.Clear;
end;

procedure TfmMain.btnDrawAllClick(Sender: TObject);
begin
 FDiagramm.Invalidate;
end;

procedure TfmMain.cbbPrimitivesChange(Sender: TObject);
begin
 FDiagramm.SelectShape(cbbPrimitives.Items, cbbPrimitives.ItemIndex);
end;

procedure TfmMain.FormCreate(Sender: TObject);
begin
 FDiagramm := TmsDiagramm.Create(imgMain);
 FDiagramm.AllowedShapesToList(cbbPrimitives.Items);
end;

procedure TfmMain.FormDestroy(Sender: TObject);
begin
 FreeAndNil(FDiagramm);
end;

procedure TfmMain.imgMainMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
begin
 Caption := 'x = ' + FloatToStr(X) + '; y = ' + FloatToStr(Y);
end;

procedure TfmMain.imgMainResize(Sender: TObject);
begin
 FDiagramm.ResizeTo(imgMain);
end;

procedure TfmMain.imgMainMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
 FDiagramm.ProcessClick(TPointF.Create(X, Y));
end;

procedure TfmMain.miAboutClick(Sender: TObject);
begin
 ShowMessage(self.Caption);
end;

procedure TfmMain.miExitClick(Sender: TObject);
begin
 self.Close;
end;

end.

Как видим весь код который у нас сначала был записан в обработчиках событий, теперь полностью спрятан в контролере TmsDiagram.

Следующим шагом добавляем список диаграмм, так как мы хотим иметь возможность независимо рисовать несколько диаграмм одновременно:

type
 TmsDiagrammList = TObjectList<TmsDiagramm>;

 TmsDiagramms = class(TObject)
 private
  f_Diagramms : TmsDiagrammList;
  f_CurrentDiagramm : TmsDiagramm;
 public
  constructor Create(anImage: TImage; aList: TStrings);
  destructor Destroy; override;
  procedure ProcessClick(const aStart: TPointF);
  procedure Clear;
  procedure SelectShape(aList: TStrings; anIndex: Integer);
  procedure AllowedShapesToList(aList: TStrings);
  procedure ResizeTo(anImage: TImage);
  procedure AddDiagramm(anImage: TImage; aList: TStrings);
  function CurrentDiagrammIndex: Integer;
  procedure SelectDiagramm(anIndex: Integer);
 end;//TmsDiagramms

implementation

uses
 System.SysUtils
 ;

constructor TmsDiagramms.Create(anImage: TImage; aList: TStrings);
begin
 inherited Create;
 f_Diagramms := TmsDiagrammList.Create;
 AddDiagramm(anImage, aList);
end;

procedure TmsDiagramms.AddDiagramm(anImage: TImage; aList: TStrings);
begin
 f_CurrentDiagramm := TmsDiagramm.Create(anImage, IntToStr(f_Diagramms.Count + 1));
 f_Diagramms.Add(f_CurrentDiagramm);
 aList.AddObject(f_CurrentDiagramm.Name, f_CurrentDiagramm);
 //f_CurrentDiagramm.Invalidate;
end;

function TmsDiagramms.CurrentDiagrammIndex: Integer;
begin
 Result := f_Diagramms.IndexOf(f_CurrentDiagramm);
end;

procedure TmsDiagramms.SelectDiagramm(anIndex: Integer);
begin
 if (anIndex < 0) OR (anIndex >= f_Diagramms.Count) then
  Exit;
 f_CurrentDiagramm := f_Diagramms.Items[anIndex];
 f_CurrentDiagramm.Invalidate;
end;

destructor TmsDiagramms.Destroy;
begin
 FreeAndNil(f_Diagramms);
 inherited;
end;

procedure TmsDiagramms.ProcessClick(const aStart: TPointF);
begin
 f_CurrentDiagramm.ProcessClick(aStart);
end;

procedure TmsDiagramms.Clear;
begin
 f_CurrentDiagramm.Clear;
end;

procedure TmsDiagramms.SelectShape(aList: TStrings; anIndex: Integer);
begin
 f_CurrentDiagramm.SelectShape(aList, anIndex);
end;

procedure TmsDiagramms.AllowedShapesToList(aList: TStrings);
begin
 f_CurrentDiagramm.AllowedShapesToList(aList);
end;

procedure TmsDiagramms.ResizeTo(anImage: TImage);
begin
 f_CurrentDiagramm.ResizeTo(anImage);
end;

end.

Как видим, класс списка диаграмм, по сути представляет обертку для каждой диаграммы, и детали реализации работы со списком.

Учитываем что у каждой диаграммы свой выбранный примитив. Добавим метод IndexOf контейнеру:

function TmsRegisteredShapes.IndexOf(const aValue : RmsShape): Integer;
begin
 Result := f_Registered.IndexOf(aValue);
end;

Теперь добавим метод диаграмме:

function TmsDiagramm.CurrentShapeClassIndex: Integer;
begin
 Result := AllowedShapes.IndexOf(FCurrentClass);
end;

И соответственно списку диаграмм:

function TmsDiagramms.CurrentShapeClassIndex: Integer;
begin
 Result := f_CurrentDiagramm.CurrentShapeClassIndex;
end;

Однако мы всё ещё обращаемся к списку диаграмм напрямую из формы, пора избавиться и от этого. Для чего мы создадим “настоящий контролер диаграмм”. Именно этот класс будет отвечать за работу контролов формы, а также за обработку событий:

type
 TmsDiagrammsController = class(TObject)
 private
  imgMain: TImage;
  cbShapes: TComboBox;
  cbDiagramm: TComboBox;
  btAddDiagramm: TButton;
  FDiagramm: TmsDiagramms;
  procedure cbDiagrammChange(Sender: TObject);
  procedure imgMainResize(Sender: TObject);
  procedure cbShapesChange(Sender: TObject);
  procedure btAddDiagrammClick(Sender: TObject);
  procedure imgMainMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
 public
  constructor Create(aImage: TImage; aShapes: TComboBox; aDiagramm: TComboBox; aAddDiagramm: TButton);
  destructor Destroy; override;
  procedure Clear;
  procedure ProcessClick(const aStart: TPointF);
 end;//TmsDiagrammsController

implementation

uses
 System.SysUtils
 ;

constructor TmsDiagrammsController.Create(aImage: TImage; aShapes: TComboBox; aDiagramm: TComboBox; aAddDiagramm: TButton);
begin
 inherited Create;
 imgMain := aImage;
 cbShapes := aShapes;
 cbDiagramm := aDiagramm;
 btAddDiagramm := aAddDiagramm;
 FDiagramm := TmsDiagramms.Create(imgMain, cbDiagramm.Items);
 FDiagramm.AllowedShapesToList(cbShapes.Items);
 cbShapes.ItemIndex := FDiagramm.CurrentShapeClassIndex;
 cbDiagramm.ItemIndex := FDiagramm.CurrentDiagrammIndex;
 cbDiagramm.OnChange := cbDiagrammChange;
 imgMain.OnResize := imgMainResize;
 cbShapes.OnChange := cbShapesChange;
 btAddDiagramm.OnClick := btAddDiagrammClick;
 imgMain.OnMouseDown := imgMainMouseDown;
end;

procedure TmsDiagrammsController.cbDiagrammChange(Sender: TObject);
begin
 FDiagramm.SelectDiagramm(cbDiagramm.ItemIndex);
 cbShapes.ItemIndex := FDiagramm.CurrentShapeClassIndex;
end;

procedure TmsDiagrammsController.imgMainResize(Sender: TObject);
begin
 FDiagramm.ResizeTo(imgMain);
end;

procedure TmsDiagrammsController.cbShapesChange(Sender: TObject);
begin
 FDiagramm.SelectShape(cbShapes.Items, cbShapes.ItemIndex);
end;

procedure TmsDiagrammsController.btAddDiagrammClick(Sender: TObject);
begin
 FDiagramm.AddDiagramm(imgMain, cbDiagramm.Items);
 cbDiagramm.ItemIndex := FDiagramm.CurrentDiagrammIndex;
 cbShapes.ItemIndex := FDiagramm.CurrentShapeClassIndex;
end;

destructor TmsDiagrammsController.Destroy;
begin
 FreeAndNil(FDiagramm);
end;

procedure TmsDiagrammsController.Clear;
begin
 FDiagramm.Clear;
end;

procedure TmsDiagrammsController.ProcessClick(const aStart: TPointF);
begin
 FDiagramm.ProcessClick(aStart);
end;

procedure TmsDiagrammsController.imgMainMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
 Self.ProcessClick(TPointF.Create(X, Y));
end;

end.

Теперь всё что нам нужно — это создать наш контролер:

procedure TfmMain.FormCreate(Sender: TObject);
begin
 FDiagrammsController := TmsDiagrammsController.Create(imgMain, cbShapes, cbDiagramm, btAddDiagramm);
end;

Картинка приложения:

UML диаграмма классов:

BitBucket repository

Итак, в статье мы показали, как последовательно избавляться от дублирования кода, благодаря использованию наследования и виртуальных функций. Привели пример Dependency Injection. Что нам очень облегчило жизнь. Иначе в коде постоянно встречались бы невнятные case of и Object is. Продемонстрировали, последовательно, как уходить от написания кода внутри обработчиков событий. Создав специальный класс контролер, который берет на себя все обязательства. Также показали, как не устраивать “швейцарских ножей” из класса, разделив каждый слой по мере ответственности. TmsDiagramm отвечает за рисование. TmsDiagramms отвечает за список диаграмм, однако кроме этого на нём также всё взаимодействие работы каждой диаграммы с основным контролером. И наконец класс TmsDiagrammsController, который является связующим звеном между пользователем и диаграммами.

P.S. Уважаемые читатели. С удовольствием выслушаю все ваши комментарии и предложения. Статья рассчитана на широкий круг читателей, поэтому некоторые моменты расписаны уж очень дотошно. Это моя первая статья на Хабре, посему, не судите строго.

Автор: instigator21

Источник