1. Alex Lulin Avatar Alex Lulin
  2. Untitled project
  3. MindStream

Wiki

Clone wiki

MindStream / Статьи на русском / MindStream. Как мы пишем ПО под FireMonkey

View History

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

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

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

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

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

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

#!delphi

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

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

#!delphi
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;

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

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

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

#!delphi
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 отвечающий за хранение всех фигур, и их рисование: 

#!delphi
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 пробегает по всему списку и вызывает соответствующий метод для каждого объекта: 

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

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

#!delphi
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;

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

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

#!delphi
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;

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

#!delphi
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: 

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

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

#!delphi
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. 

#!delphi
initialization
 TmsRegisteredPrimitives.GetInstance.AddPrimitive(TmsLine);
 TmsRegisteredPrimitives.GetInstance.AddPrimitive(TmsRectangle);
end.

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

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

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

#!delphi
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: 

#!delphi
 property CurrentClass : RmsShape read FCurrentClass write FCurrentClass;

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

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

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

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

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

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

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

#!delphi
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 и перестанем создавать его на форме. 

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

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

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

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

#!delphi
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;

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

#!delphi
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, и так как мы его не освобождали, то вызовем метод финализации фигуры, где установим вторую точку линии, и освободим наш буферный объект: 

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

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

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

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

#!delphi
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: 

#!delphi
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;

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

#!delphi
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 поэтому при нажатии второй раз мышкой, наш холст будет перерисован, и круга уже не будет.

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

#!delphi
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.

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

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

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

#!delphi
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 теперь выглядит так: 

#!delphi
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: 

#!delphi
initialization
 TmsRectangle.Register;

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

#!delphi
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, и изменим рисование, заодно убрав магические числа. 

#!delphi
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 с необходимым углом округления углов. Класс в целом выглядит так: 

#!delphi
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.

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

#!delphi
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. А также перепишем метод рисования у супер класса.

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

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

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

#!delphi
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;

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

#!delphi
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.

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

#!delphi
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, тем самым выделим полноценный контролер который отвечает за создания и рисование всех фигур нашего приложения. 

#!delphi
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.

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

#!delphi
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.

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

#!delphi
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 контейнеру: 

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

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

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

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

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

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

#!delphi
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.

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

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

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

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

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

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

Updated