Wiki
Clone wikiMindStream / Статьи на русском / MindStream. Как мы пишем ПО под FireMonkey 2
В этой статье я продолжу рассказ о том, как мы пишем под FireMonkey. Будет добавлено 2 интересных объекта. Оба напомнят нам о векторной алгебре и тригонометрии. Также в посте будут показаны приемы из ООП, которыми мы пользуемся.
Ряд линий (отличаются только пунктиром, точка-тире, точка-точка, etc), которые мы добавили, были сделаны по аналогии с описанием предыдущих примитивов. Теперь время перейти к более сложным фигурам (включая составные).
Первый примитив, который мы добавим, будет линия со стрелкой (стрелкой будет рисоваться обычный треугольник, но меньших размеров).
Для начала введем треугольник который «смотрит вправо». Для этого унаследуем обычный треугольник и перепишем ему метод Polygon, который отвечает за координаты вершин.
#!delphi function TmsTriangleDirectionRight.Polygon: TPolygon; begin SetLength(Result, 4); Result[0] := TPointF.Create(StartPoint.X - InitialHeight / 2, StartPoint.Y - InitialHeight / 2); Result[1] := TPointF.Create(StartPoint.X - InitialHeight / 2, StartPoint.Y + InitialHeight / 2); Result[2] := TPointF.Create(StartPoint.X + InitialHeight / 2, StartPoint.Y); Result[3] := Result[0]; end;
Вот так выглядят наши треугольники:
Далее унаследуем так называемый «маленький треугольник»:
#!delphi type TmsSmallTriangle = class(TmsTriangleDirectionRight) protected function FillColor: TAlphaColor; override; public class function InitialHeight: Single; override; end; // TmsSmallTriangle
Как видим, всё что мы сделали, это переопределили функции уникальные для нового треугольника.
Следующим классом добавим линию со стрелкой, которую унаследуем от обычной линии. В классе будет переопределена только процедура рисования самого примитива, то есть линию будет рисовать базовый класс, а вот треугольник — наследник.
#!delphi procedure TmsLineWithArrow.DoDrawTo(const aCtx: TmsDrawContext); var l_Proxy : TmsShape; l_OriginalMatrix: TMatrix; l_Matrix: TMatrix; l_Angle : Single; l_CenterPoint : TPointF; l_TextRect : TRectF; begin inherited; if (StartPoint <> FinishPoint) then begin l_OriginalMatrix := aCtx.rCanvas.Matrix; try l_Proxy := TmsSmallTriangle.Create(FinishPoint); try // пока в целях эксперимента укажем поворот 0 градусов, // что бы убедиться что треугольник рисуется правильно l_Angle := DegToRad(0); l_CenterPoint := TPointF.Create(FinishPoint.X , FinishPoint.Y); // Запомнили начальную матрицу l_Matrix := l_OriginalMatrix; // Перенесли начало координат в точку вокруг которой будет осуществлен поворот l_Matrix := l_Matrix * TMatrix.CreateTranslation(-l_CenterPoint.X, -l_CenterPoint.Y); // Собственно - сам поворот l_Matrix := l_Matrix * TMatrix.CreateRotation(l_Angle); // Вернули начало координат на место l_Matrix := l_Matrix * TMatrix.CreateTranslation(l_CenterPoint.X, l_CenterPoint.Y); // собственно применяем нашу матрицу пространства к холсту aCanvas.SetMatrix(l_Matrix); // рисуем l_Proxy.DrawTo(aCanvas, aOrigin); finally FreeAndNil(l_Proxy); end; // try..finally finally // Так как мы отрисовали нужную нам фигуру, возвращаем начальную матрицу холсту. aCanvas.SetMatrix(l_OriginalMatrix); end; end;//(StartPoint <> FinishPoint) end;
Далее задача становится более интересной. Нам необходимо поворачивать треугольник, прямо перпендикулярно линии, которая его нарисовала. Для этого введем метод GetArrowAngleRotation, который будет рассчитывать угол поворота. Для этого представим, что наша линия — это гипотенуза прямоугольного треугольника; далее найдем угол с катетом, который и будет углом поворота треугольника относительно линии:
#!delphi function TmsLineWithArrow.GetArrowAngleRotation: Single; var l_ALength, l_CLength, l_AlphaAngle, l_X, l_Y, l_RotationAngle: Single; l_PointC: TPointF; l_Invert: SmallInt; begin Result := 0; // Формула расчета растояний между двумя точками l_X := (FinishPoint.X - StartPoint.X) * (FinishPoint.X - StartPoint.X); l_Y := (FinishPoint.Y - StartPoint.Y) * (FinishPoint.Y - StartPoint.Y); // Находим длинну гипотенузы прямоугольного треугольника l_CLength := sqrt(l_X + l_Y); l_PointC := TPointF.Create(FinishPoint.X, StartPoint.Y); // Формула расчета растояний между двумя точками l_X := (l_PointC.X - StartPoint.X) * (l_PointC.X - StartPoint.X); l_Y := (l_PointC.Y - StartPoint.Y) * (l_PointC.Y - StartPoint.Y); // Находим длинну катета l_ALength := sqrt(l_X + l_Y); // Угол в радианах l_AlphaAngle := ArcSin(l_ALength / l_CLength); l_RotationAngle := 0; l_Invert := 1; if FinishPoint.X > StartPoint.X then begin l_RotationAngle := Pi / 2 * 3; if FinishPoint.Y > StartPoint.Y then l_Invert := -1; end else begin l_RotationAngle := Pi / 2; if FinishPoint.Y < StartPoint.Y then l_Invert := -1; end; Result := l_Invert * (l_AlphaAngle + l_RotationAngle); end;
Алгоритм, которым мы воспользуемся:
- Нам необходим метод для определения попадания точки в конкретную фигуру, скажем ContainsPt, для каждой фигуры; так как формулы для расчета попадания для каждой фигуры уникальны, пользуемся виртуальными функциями.
- Следующий метод нам необходим для определения, в какую фигуру мы попали, если они пересекаются. Так как фигуры попадают в список по мере их появления на форме, то для случая пересечения фигур та из фигур, которая находится в начале списка, является последней появившейся, соответственно лежит «сверху». На самом деле, в этой логике есть прокол, однако пока решим, что это правильно, а исправления оставим для следующего поста.
- При первом нажатии в фигуру, в которую попали, мы должны изменить её контур или ряд других характеристик.
- При втором нажатии мы должны переместить фигуру, в которую попали.
Сам класс перемещения будет наследоваться от стандартной фигуры, однако будет в себе хранить фигуру, которую он перемещает, и именно он при втором клике (в прошлом посте я описывал, в чём особенность рисования линий) будет перерисовывать фигуру.
Реализуем методы, которые я описал.
-
Метод определяет, попадает ли точка в фигуру(в нашем случае прямоугольник):
#!delphi function TmsRectangle.ContainsPt(const aPoint: TPointF): Boolean; var l_Finish : TPointF; l_Rect: TRectF; begin Result := False; l_Finish := TPointF.Create(StartPoint.X + InitialWidth, StartPoint.Y + InitialHeight); l_Rect := TRectF.Create(StartPoint,l_Finish); Result := l_Rect.Contains(aPoint); end;
-
Этот метод при нажатии отвечает, нам на вопрос — в какую фигуру мы попали:
#!delphi class function TmsShape.ShapeByPt(const aPoint: TPointF; aList: TmsShapeList): TmsShape; var l_Shape: TmsShape; l_Index: Integer; begin Result := nil; for l_Index := aList.Count - 1 downto 0 do begin l_Shape := aList.Items[l_Index]; if l_Shape.ContainsPt(aPoint) then begin Result := l_Shape; Exit; end; // l_Shape.ContainsPt(aPoint) end; // for l_Index end;
- При первом нажатии в фигуру, в которую попали, мы должны изменить её контур или ряд других характеристик.
Для реализации следующего метода сделаем небольшой рефакторинг. Введем так называемый «контекст рисования»:
#!delphi type TmsDrawContext = record public rCanvas: TCanvas; rOrigin: TPointF; rMoving: Boolean; // - определяем, что текущий рисуемый примитив - двигается constructor Create(const aCanvas: TCanvas; const aOrigin: TPointF); end; // TmsDrawContext
Если мы укажем фигуре в контексте рисования что она «перемещаемая», то рисование будет происходить иначе.
#!delphi procedure TmsShape.DrawTo(const aCtx: TmsDrawContext); begin aCtx.rCanvas.Fill.Color := FillColor; if aCtx.rMoving then begin aCtx.rCanvas.Stroke.Dash := TStrokeDash.sdDashDot; aCtx.rCanvas.Stroke.Color := TAlphaColors.Darkmagenta; aCtx.rCanvas.Stroke.Thickness := 4; end else begin aCtx.rCanvas.Stroke.Dash := StrokeDash; aCtx.rCanvas.Stroke.Color := StrokeColor; aCtx.rCanvas.Stroke.Thickness := StrokeThickness; end; DoDrawTo(aCtx); end;
- При втором нажатии мы должны переместить фигуру, в которую попали.
Для начала введём фабричный метод который отвечает за построение фигуры(список фигур необходим нам для того, что бы TmsMover смог обратиться ко всем фигурам, которые нарисованы в рамках текущей диаграммы).
#!delphi class function TmsShape.Make(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList): TmsShape; begin Result := Create(aStartPoint); end;
#!delphi class function TmsMover.Make(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList): TmsShape; var l_Moving: TmsShape; begin // Ищём попадание в фигуру l_Moving := ShapeByPt(aStartPoint, aListWithOtherShapes); if (l_Moving <> nil) then Result := Create(aStartPoint, aListWithOtherShapes, l_Moving) else Result := nil; end;
Благодаря использованию классовой функции, мы принципиально разделили создание объекта перемещения и всех остальных фигур. Тем не менее, у этого подхода есть и отрицательная сторона. Например, мы ввели параметр создания aListWithOtherShapes, который совсем не нужен другим фигурам.
#!delphi type TmsMover = class(TmsShape) private f_Moving: TmsShape; f_ListWithOtherShapes: TmsShapeList; protected procedure DoDrawTo(const aCtx: TmsDrawContext); override; constructor Create(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList; aMoving: TmsShape); public class function Make(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList): TmsShape; override; class function IsNeedsSecondClick: Boolean; override; procedure EndTo(const aFinishPoint: TPointF); override; end; // TmsMover implementation uses msRectangle, FMX.Types, System.SysUtils; constructor TmsMover.Create(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList; aMoving: TmsShape); begin inherited Create(aStartPoint); f_ListWithOtherShapes := aListWithOtherShapes; f_Moving := aMoving; end; class function TmsMover.Make(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList): TmsShape; var l_Moving: TmsShape; begin l_Moving := ShapeByPt(aStartPoint, aListWithOtherShapes); if (l_Moving <> nil) then Result := Create(aStartPoint, aListWithOtherShapes, l_Moving) else Result := nil; end; class function TmsMover.IsNeedsSecondClick: Boolean; begin Result := true; end; procedure TmsMover.EndTo(const aFinishPoint: TPointF); begin if (f_Moving <> nil) then f_Moving.MoveTo(aFinishPoint); f_ListWithOtherShapes.Remove(Self); // - теперь надо СЕБЯ удалить, так как после выполнения своей функции, мувер не нужен в общем списке end; procedure TmsMover.DoDrawTo(const aCtx: TmsDrawContext); var l_Ctx: TmsDrawContext; begin if (f_Moving <> nil) then begin l_Ctx := aCtx; l_Ctx.rMoving := true; f_Moving.DrawTo(l_Ctx); end; // f_Moving <> nil end; initialization TmsMover.Register; end.
В контролере нам необходимо только изменить методы создания фигур:
#!delphi procedure TmsDiagramm.BeginShape(const aStart: TPointF); begin Assert(CurrentClass <> nil); FCurrentAddedShape := CurrentClass.Make(aStart, FShapeList); if (FCurrentAddedShape <> nil) then begin FShapeList.Add(FCurrentAddedShape); if not FCurrentAddedShape.IsNeedsSecondClick then // - если не надо SecondClick, то наш примитив - завершён FCurrentAddedShape := nil; Invalidate; end; // FCurrentAddedShape <> nil end; procedure TmsDiagramm.EndShape(const aFinish: TPointF); begin Assert(CurrentAddedShape <> nil); CurrentAddedShape.EndTo(aFinish); FCurrentAddedShape := nil; Invalidate; end;
Вызов CurrentAddedShape.EndTo(aFinish) в случае с мувером вызовет MoveTo, то есть переместит фигуру; перерисовку же, как видно выше, инициирует контролер:
#!delphi procedure TmsMover.EndTo(const aFinishPoint: TPointF); begin if (f_Moving <> nil) then f_Moving.MoveTo(aFinishPoint); f_ListWithOtherShapes.Remove(Self); // - теперь надо СЕБЯ удалить, так как фигура мувер не нужна в общем списке end;
#!delphi procedure TmsShape.MoveTo(const aFinishPoint: TPointF); begin FStartPoint := aFinishPoint; end;
Так как контролер отвечает за логику поведение фигур, то вынесем метод проверки «попадания в фигуру» в контролер, а при создании объектов будем передавать функцию проверки:
#!delphi type TmsShapeByPt = function (const aPoint: TPointF): TmsShape of object; ... class function Make(const aStartPoint: TPointF; aShapeByPt: TmsShapeByPt): TmsShape; override; ... procedure TmsDiagramm.BeginShape(const aStart: TPointF); begin Assert(CurrentClass <> nil); // Собственно сам вызов FCurrentAddedShape := CurrentClass.Make(aStart, Self.ShapeByPt); if (FCurrentAddedShape <> nil) then begin FShapeList.Add(FCurrentAddedShape); if not FCurrentAddedShape.IsNeedsSecondClick then // - если не надо SecondClick, то наш примитив - завершён FCurrentAddedShape := nil; Invalidate; end;//FCurrentAddedShape <> nil end;
Так как для создания объектов необходимо передать 2 параметра, создаем контекст «создания»:
#!delphi type TmsMakeShapeContext = record public rStartPoint: TPointF; rShapeByPt: TmsShapeByPt; constructor Create(aStartPoint: TPointF; aShapeByPt: TmsShapeByPt); end;//TmsMakeShapeContext
Добавим интерфейсы, которые будет реализовывать контролер, а также добавим класс интерфейсного объекта. В будущем в нём мы реализуем собственный подсчет ссылок.
#!delphi type TmsInterfacedNonRefcounted = class abstract(TObject) protected function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; end;//TmsInterfacedNonRefcounted TmsShape = class; ImsShapeByPt = interface function ShapeByPt(const aPoint: TPointF): TmsShape; end;//ImsShapeByPt ImsShapesController = interface procedure RemoveShape(aShape: TmsShape); end;//ImsShapeRemover
Слегка изменим TmsMakeShapeContext:
#!delphi type TmsMakeShapeContext = record public rStartPoint: TPointF; rShapesController: ImsShapesController; constructor Create(aStartPoint: TPointF; const aShapesController: ImsShapesController); end; // TmsMakeShapeContext
Детальнее об интерфейсах и особенностях работы с ними в Delphi рекомендую 2 интерестных поста:
Сделаем наш контролер(TmsDiagramm) унаследованным от TmsInterfacedNonRefcounted и интерфейсов и изменим в методе BeginShape одну строчку. было:
#!delphi FCurrentAddedShape := CurrentClass.Make(aStart, Self.ShapeByPt);
#!delphi FCurrentAddedShape := CurrentClass.Make(TmsMakeShapeContext.Create(aStart, Self));
#!delphi procedure TmsMover.EndTo(const aCtx: TmsEndShapeContext); begin if (f_Moving <> nil) then f_Moving.MoveTo(aCtx.rStartPoint); f_Moving := nil; aCtx.rShapesController.RemoveShape(Self); // - теперь надо СЕБЯ удалить end;
В прошлом посте я рассказывал о том, как мы спрятали «уникальные настройки» (цвет заливки, толщина линий и т.д.) в виртуальные методы, которые каждая фигура устанавливает самостоятельно. Например:
#!delphi function TmsTriangle.FillColor: TAlphaColor; begin Result := TAlphaColorRec.Green; end;
Все настройки фигур «упаковываем» в контекст:
#!delphi type TmsDrawOptionsContext = record public rFillColor: TAlphaColor; rStrokeDash: TStrokeDash; rStrokeColor: TAlphaColor; rStrokeThickness: Single; constructor Create(const aCtx: TmsDrawContext); end;//TmsDrawOptionsContext
В классе TmsShape делаем виртуальную процедуру по аналогии с предыдущим пример. В будущем мы с легкостью расширим количество настроек уникальных для фигуры:
#!delphi procedure TmsTriangle.TransformDrawOptionsContext(var theCtx: TmsDrawOptionsContext); begin inherited; theCtx.rFillColor := TAlphaColorRec.Green; theCtx.rStrokeColor := TAlphaColorRec.Blue; end;
Благодаря контексту, убираем логику (мувер ли мы рисуем ?) из метода рисования и прячем её в конструктор записи:
#!delphi constructor TmsDrawOptionsContext.Create(const aCtx: TmsDrawContext); begin rFillColor := TAlphaColorRec.Null; if aCtx.rMoving then begin rStrokeDash := TStrokeDash.sdDashDot; rStrokeColor := TAlphaColors.Darkmagenta; rStrokeThickness := 4; end // aCtx.rMoving else begin rStrokeDash := TStrokeDash.sdSolid; rStrokeColor := TAlphaColorRec.Black; rStrokeThickness := 1; end; // aCtx.rMoving end;
После чего наш метод для рисования будут выглядеть так:
#!delphi procedure TmsShape.DrawTo(const aCtx: TmsDrawContext); var l_Ctx: TmsDrawOptionsContext; begin l_Ctx := DrawOptionsContext(aCtx); aCtx.rCanvas.Fill.Color := l_Ctx.rFillColor; aCtx.rCanvas.Stroke.Dash := l_Ctx.rStrokeDash; aCtx.rCanvas.Stroke.Color := l_Ctx.rStrokeColor; aCtx.rCanvas.Stroke.Thickness := l_Ctx.rStrokeThickness; DoDrawTo(aCtx); end; function TmsShape.DrawOptionsContext(const aCtx: TmsDrawContext): TmsDrawOptionsContext; begin Result := TmsDrawOptionsContext.Create(aCtx); // Получаем уникальные настройки для каждой фигуры TransformDrawOptionsContext(Result); end;
Всё, что нам осталось для того, чтобы наши объекты перемещались, это написать каждой фигуре метод ContainsPt, который будет проверять, попала ли точка в фигуру. Обычная тригонометрия, все формулы есть на просторах интернета.
Слегка переделаем регистрацию объектов в контейнере. Сейчас каждый класс «регистрирует» сам себя. Вынесем регистрацию в отдельный модуль.
#!delphi unit msOurShapes; interface uses msLine, msRectangle, msCircle, msRoundedRectangle, msUseCaseLikeEllipse, msTriangle, msDashDotLine, msDashLine, msDotLine, msLineWithArrow, msTriangleDirectionRight, msMover, msRegisteredShapes ; implementation procedure RegisterOurShapes; begin TmsRegisteredShapes.Instance.Register([ TmsLine, TmsRectangle, TmsCircle, TmsRoundedRectangle, TmsUseCaseLikeEllipse, TmsTriangle, TmsDashDotLine, TmsDashLine, TmsDotLine, TmsLineWithArrow, TmsTriangleDirectionRight, TmsMover ]); end; initialization RegisterOurShapes; end.
В контейнере допишем метод регистрации:
#!delphi procedure TmsRegisteredShapes.Register(const aShapes: array of RmsShape); var l_Index: Integer; begin for l_Index := Low(aShapes) to High(aShapes) do Self.Register(aShapes[l_Index]); end; procedure TmsRegisteredShapes.Register(const aValue: RmsShape); begin Assert(f_Registered.IndexOf(aValue) < 0); f_Registered.Add(aValue); end;
В этом посте мы пытались показать, как благодаря использованию контекстов, интерфейсов и фабричного метода облегчить себе жизнь. Более детально о фабричном методе можно ознакомиться тут и [тут](https://ru.wikipedia.org/wiki/%D0%A4%D0%B0%D0%B1%D1%80%D0%B8%D1%87%D0%BD%D1%8B%D0%B9_%D0%BC%D0%B5%D1%82%D0%BE%D0%B4_(%D1%88%D0%B0%D0%B1%D0%BB%D0%BE%D0%BD_%D0%BF%D1%80%D0%BE%D0%B5%D0%BA%D1%82%D0%B8%D1%80%D0%BE%D0%B2%D0%B0%D0%BD%D0%B8%D1%8F).
В следующем посте расскажем о том, как мы «прикручивали» DUnit к FireMonkey. И напишем несколько тестов, некоторые из которых сразу вызовут ошибку.
Updated