[Из песочницы] 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
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
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
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. Уважаемые хабраюзеры. С удовольствием выслушаю все ваши комментарии и предложения. Статья рассчитана на широкий круг читателей, поэтому некоторые моменты расписаны уж очень дотошно. Это моя первая статья на Хабре, посему, не судите строго.
