マインドストリーム。 FireMonkeyでソフトウェアを作成するとき。 パート2

パート1



こんにちは。



この記事では、FireMonkeyでの記述方法の話を続けます。 2つの興味深いオブジェクトが追加されます。 どちらもベクトル代数と三角法を思い出させます。 また、この投稿では、私たちが使用しているOOPのテクニックを紹介します。





追加した多くの行（破線、一点鎖線、二点鎖線など）は、前のプリミティブの説明との類似性によって作成されました。 今こそ、より複雑な形状（複合形状を含む）に進むときです。



追加する最初のプリミティブは、矢印付きの線になります（通常の三角形は矢印付きで描画されますが、それより小さくなります）。



まず、「右に見える」三角形を導入します。 これを行うには、通常の三角形を継承し、頂点の座標を処理するPolygonメソッドを書き換えます。

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;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

これは三角形がどのように見えるかです：







次に、いわゆる「小さな三角形」を継承します。

 type TmsSmallTriangle = class(TmsTriangleDirectionRight) protected function FillColor: TAlphaColor; override; public class function InitialHeight: Single; override; end; // TmsSmallTriangle
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

ご覧のとおり、新しい三角形に固有の関数を再定義するだけでした。



次のクラスでは、矢印のある行を追加します。これは通常の行から継承します。 プリミティブ自体の描画手順のみがクラスで再定義されます。つまり、基本クラスは線を描画しますが、三角形は相続人です。

 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;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

ここで分析する特別なものはありません、すべてがコメントで既に示されていますが、ベクトル代数とは何か、ベクトルグラフィックスの処理方法（移動、さまざまな形状の回転など）を覚えたい場合は、このテーマに関するHabréの素晴らしい投稿をお勧めします。記事「Vectors for Dummies。 ベクトルを使用したアクション。 ベクトル座標。 ベクトルに関する最も単純な問題」および「 ベクトルの 線形依存性と線形独立性。 ベクトルの基礎。 アフィン座標系。」



写真からわかるように、現在、三角形は左から右に線を引いたときにのみ描画されます。







さらに、タスクはより面白くなります。 三角形を、それを描いた線に直角に回転させる必要があります。 これを行うために、回転角度を計算するGetArrowAngleRotationメソッドを導入します。

これを行うには、線が直角三角形の斜辺であると想像してください。 次に、脚に対する角度を見つけます。これは、直線に対する三角形の回転角度になります。

 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;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

行は次のようになります。





追加する次のオブジェクトは、図形の移動を担当します。



使用するアルゴリズム：

1.各シェイプについて、ポイントが特定のシェイプ（ContainsPtなど）に当たるかどうかを判断する方法が必要です。 各図のヒットを計算する式は一意であるため、仮想関数を使用します。

2.次の方法は、交差する場合にどの図にいるかを判断するために必要です。 図形はフォームに表示されるときにリストに含まれるため、図形の交差の場合、リストの一番上にある図形の最後がそれぞれ「上」に表示されます。 実際、このロジックにはパンクがありますが、今のところ、これが正しいと判断し、次の投稿のために修正を残しましょう。

3.ヒットしたシェイプを初めてクリックするときは、アウトラインまたは他の多くの特性を変更する必要があります。

4. 2回目に押すと、ヒットした図形を移動する必要があります。



移動クラス自体は標準のシェイプから継承されますが、移動するシェイプはそれ自体に保存され、2回目のクリックでシェイプを再描画するのは彼です（最後の投稿で、線画の特殊性について説明しました）。



説明したメソッドを実装します。

1.このメソッドは、ポイントが形状（この場合は長方形）に該当するかどうかを判別します。

 function TmsRectangle.ContainsPt(const aPoint: TPointF): Boolean; var l_Finish : TPointF; l_Rect: TRectF; begin Result := False; l_Finish := TPointF.Create(StartPoint.X + InitialWidth, StartPoint.Y + InitialHeight); l_Rect := TRectF.Create(StartPoint,l_Finish); Result := l_Rect.Contains(aPoint); end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

2.このメソッドは、押されると答えられ、質問が表示されます。

 class function TmsShape.ShapeByPt(const aPoint: TPointF; aList: TmsShapeList): TmsShape; var l_Shape: TmsShape; l_Index: Integer; begin Result := nil; for l_Index := aList.Count - 1 downto 0 do begin l_Shape := aList.Items[l_Index]; if l_Shape.ContainsPt(aPoint) then begin Result := l_Shape; Exit; end; // l_Shape.ContainsPt(aPoint) end; // for l_Index end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

3.ヒットしたシェイプを初めてクリックするときは、アウトラインまたは他の多くの特性を変更する必要があります。

次のメソッドを実装するために、少しリファクタリングを行います。 いわゆる「描画コンテキスト」を紹介します。

 type TmsDrawContext = record public rCanvas: TCanvas; rOrigin: TPointF; rMoving: Boolean; // - ,     -  constructor Create(const aCanvas: TCanvas; const aOrigin: TPointF); end; // TmsDrawContext
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

描画のコンテキストで図に「再配置可能」であることを示すと、描画は異なる方法で行われます。

 procedure TmsShape.DrawTo(const aCtx: TmsDrawContext); begin aCtx.rCanvas.Fill.Color := FillColor; if aCtx.rMoving then begin aCtx.rCanvas.Stroke.Dash := TStrokeDash.sdDashDot; aCtx.rCanvas.Stroke.Color := TAlphaColors.Darkmagenta; aCtx.rCanvas.Stroke.Thickness := 4; end else begin aCtx.rCanvas.Stroke.Dash := StrokeDash; aCtx.rCanvas.Stroke.Color := StrokeColor; aCtx.rCanvas.Stroke.Thickness := StrokeThickness; end; DoDrawTo(aCtx); end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

4. 2回目に押すと、ヒットした図形を移動する必要があります。

まず、図の作成を担当するファクトリメソッドを導入します（現在のチャート内に描画されたすべての形状にTmsMoverがアクセスできるようにするには、形状のリストが必要です）。

 class function TmsShape.Make(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList): TmsShape; begin Result := Create(aStartPoint); end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

 class function TmsMover.Make(const aStartPoint: TPointF; aListWithOtherShapes: TmsShapeList): TmsShape; var l_Moving: TmsShape; begin //     l_Moving := ShapeByPt(aStartPoint, aListWithOtherShapes); if (l_Moving <> nil) then Result := Create(aStartPoint, aListWithOtherShapes, l_Moving) else Result := nil; end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

クラス関数を使用したおかげで、変位オブジェクトと他のすべての図形の作成を根本的に分割しました。 ただし、このアプローチにはマイナス面があります。 たとえば、aListWithOtherShapesを作成するオプションを導入しました。これは、他の図形ではまったく必要ありません。

 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.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

コントローラーでは、形状の作成方法を変更するだけです。

 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が呼び出されます。つまり、フィギュアが移動します。 上記のように、再描画はコントローラーによって開始されます。

 procedure TmsMover.EndTo(const aFinishPoint: TPointF); begin if (f_Moving <> nil) then f_Moving.MoveTo(aFinishPoint); f_ListWithOtherShapes.Remove(Self); // -    ,          end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

 procedure TmsShape.MoveTo(const aFinishPoint: TPointF); begin FStartPoint := aFinishPoint; end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

コントローラーは図形の動作のロジックを担当しているため、コントローラーで「図形に入る」ための検証メソッドを発行し、オブジェクトを作成するときに検証関数を転送します。

 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つのパラメーターを渡す必要があるため、「作成」コンテキストを作成します。

 type TmsMakeShapeContext = record public rStartPoint: TPointF; rShapeByPt: TmsShapeByPt; constructor Create(aStartPoint: TPointF; aShapeByPt: TmsShapeByPt); end;//TmsMakeShapeContext
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

コントローラが実装するインターフェイスを追加し、インターフェイスオブジェクトクラスも追加します。 将来的には、独自の参照カウントを実装します。

 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を少し変更します。

 type TmsMakeShapeContext = record public rStartPoint: TPointF; rShapesController: ImsShapesController; constructor Create(aStartPoint: TPointF; const aShapesController: ImsShapesController); end; // TmsMakeShapeContext
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

インターフェイスとDelphiでのインターフェイスの機能の詳細については、2つの興味深い投稿をお勧めします。



18delphi.blogspot.com/2013/04/iunknown.html

habrahabr.ru/post/181107



コントローラー（TmsDiagramm）をTmsInterfacedNonRefcountedおよびインターフェイスから継承し、BeginShapeメソッドの1行を変更してみましょう。

だった：

  FCurrentAddedShape := CurrentClass.Make(aStart, Self.ShapeByPt);
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

になりました：

  FCurrentAddedShape := CurrentClass.Make(TmsMakeShapeContext.Create(aStart, Self));
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

移動の場合、ムーバーで呼び出されるEndToメソッドは次の形式を取ります。

 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;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

前回の投稿で、各図が個別に設定する仮想メソッドで「一意の設定」（塗りつぶしの色、線の太さなど）をどのように隠したかについて話しました。 例：

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

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

図のすべての設定をコンテキストに「パック」します。

 type TmsDrawOptionsContext = record public rFillColor: TAlphaColor; rStrokeDash: TStrokeDash; rStrokeColor: TAlphaColor; rStrokeThickness: Single; constructor Create(const aCtx: TmsDrawContext); end;//TmsDrawOptionsContext
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

TmsShapeクラスでは、前の例と同様に仮想手順を作成します。 将来的には、図に固有の設定の数を簡単に拡張する予定です。

 procedure TmsTriangle.TransformDrawOptionsContext(var theCtx: TmsDrawOptionsContext); begin inherited; theCtx.rFillColor := TAlphaColorRec.Green; theCtx.rStrokeColor := TAlphaColorRec.Blue; end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

コンテキストのおかげで、描画メソッドからロジックを削除し（移動していますか？）、記録コンストラクターで非表示にします。

 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;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

その後、描画メソッドは次のようになります。

 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メソッドを各Figureに書き込むことだけです。このメソッドは、ポイントがFigureにヒットしたかどうかをチェックします。 通常の三角法、すべての数式はインターネット上にあります。









コンテナ内のオブジェクトの登録を少しやり直します。 現在、各クラスはそれ自体を「登録」しています。 別のモジュールに登録します。

 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.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

コンテナに、登録メソッドを追加します。

 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;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

リポジトリへのリンク。



この投稿では、コンテキスト、インターフェイス、およびファクトリメソッドを使用して生活を楽にする方法を示しました。 ファクトリメソッドの詳細については、 こちらとこちらをご覧ください 。



次の投稿では、DUnitをFireMonkeyに「ねじ込んだ」方法について説明します。 そして、いくつかのテストを作成します。そのうちのいくつかはすぐにエラーを引き起こします。



パート3

パート3.1