delphi - FireMonkey PenMode に相当するもの - DrawLine

Question

いくつかのことをテストするためだけに、FireMonkey をいじっています。そのうちの 1 つは、キャンバス上に「非常に単純な」描画を実装することです。例: 線、長方形など...

最初の質問は、VCL for FireMonkey 用に提供されている Graphex デモに相当するものはありますか?

それ以外の場合は、演習の目的で、そのデモを FireMonkey で複製しようとしていますが、今は線画です。マウスを線画の周りに移動すると、期待どおりに線画が機能します。残念ながら、マウスがあった前のポイントに描かれた古い線を自動的に消去することはできません。これは、FireMonkey の TStroke プロパティである TPen プロパティの TPenMode プロパティによって処理されているようです。つまり、描画中 (マウスの移動中) にプロパティを pmXor に設定し、完了したら pmCopy に設定します。

FireMonkey で同様のことを行うにはどうすればよいでしょうか?

TImage の MouseMove イベント中に呼び出されるルーチンは次のとおりです。

  FDrawSurface.Bitmap.Canvas.BeginScene;
  try
    case FShapeToDraw of
      doLine:
      begin
        FDrawSurface.Bitmap.Canvas.DrawLine(PointF(TopLeft.X, TopLeft.Y), PointF(BottomRight.X, BottomRight.Y), 100);
      end;

    end;
  finally
    FDrawSurface.Bitmap.Canvas.EndScene;
    FDrawSurface.Bitmap.BitmapChanged;
  end;

FDrawSurface は TImage です。TopLeft は、マウスが TImaeg の OnMouseDown イベントでキャプチャされた場所の X および Y を含む TPoint であり、BottomRight は、OnMouseMove イベントからの現在の X および Y 座標です。

そのため、マウスを動かすたびに、画像に「追加」の線が表示されます。

ありがとう

score 4 · Accepted Answer

私の知る限り、FMXにはこのようなモードはありません...さらに、キャンバスに描いたものは実際には保存されません（直接保存する方法を知っている場合は、コメントで説明してください）：フォームをデスクトップの外に移動すると、それを元に戻すと、キャンバスがきれいになります...

したがって、graphex デモを実装するには、他の技術を使用してコーディングする必要があります。

たとえば、TBitmap を使用して実際の「画像」を保存し、キャンバスを「プレビュー」にのみ使用します...

unit main;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects;

type
  TfrmMain = class(TForm)
    recBoard: TRectangle;
    btnCopy: TButton;
    Image1: TImage;
    procedure recBoardMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure recBoardMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure recBoardMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure recBoardMouseInOut(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnCopyClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    bmp: TBitmap;
    pFrom, pTo: TPointF;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.fmx}

procedure TfrmMain.btnCopyClick(Sender: TObject);
begin
  Image1.Bitmap.Assign(bmp);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  pFrom := PointF(-1, -1);
  bmp := TBitmap.Create(Round(recBoard.Width), Round(recBoard.Height));
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  bmp.Free;
end;

procedure TfrmMain.recBoardMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  if Button = TMouseButton.mbLeft then
  begin
    pFrom := PointF(X, Y);
    pTo   := PointF(X, Y);
  end;
end;

procedure TfrmMain.recBoardMouseInOut(Sender: TObject);
begin
  pFrom := PointF(-1, -1);
end;

procedure TfrmMain.recBoardMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
  if ((pFrom.X <> -1) and (pFrom.X <> -1)) then
  with recBoard.Canvas do
  begin
    BeginScene;
    if ssLeft in Shift then
    begin
      FillRect(RectF(0, 0, bmp.Width, bmp.Height), 0, 0, [], 255);
      DrawBitmap(bmp, RectF(0, 0, bmp.Width, bmp.Height), RectF(0, 0, bmp.Width, bmp.Height), 255);
      Stroke.Color := claBlue;
      pTo := PointF(X, Y);
      DrawEllipse(RectF(pFrom.X, pFrom.Y, pTo.X, pTo.Y), 255);
    end;
    EndScene;
  end;
  Self.Caption := Format('(%0.0f;%0.0f)', [X, Y]);
end;

procedure TfrmMain.recBoardMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  with bmp.Canvas do
  begin
    BeginScene;
    DrawEllipse(RectF(pFrom.X, pFrom.Y, pTo.X, pTo.Y), 255);
    EndScene;
  end;
  pFrom := PointF(-1, -1);
end;


















end.

score 2 · Accepted Answer

上記のWhilerからの洞察に基づいて、私がやったことは、「描画ルーチン」の開始時（つまり、マウスダウン）、次にMouseMoveで、新しい行をレンダリングする前に（この例では）、ビットマップの状態を保存することでした。状態を復元してから、新しい線を引きます...

procedure TFMXDrawSurface.DrawSurfaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  FOrigin := PointF(X, Y);
  FMovePt := PointF(X, Y);
  FPrevPt := PointF(X, Y);
  FDrawing := True;
  FTempDrawbitmap.Assign(FDrawSurface.Bitmap);
end;

procedure TFMXDrawSurface.DrawSurfaceMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
  if FDrawing then
  begin
    DrawShape(FOrigin, FMovePt);
    FMovePt := PointF(X, Y);
    DrawShape(FOrigin, FMovePt);
    FPrevPt := PointF(X, Y);
  end;
end;

procedure TFMXDrawSurface.DrawShape(TopLeft, BottomRight: TPointF);
var
  R: TRectF;
begin
  FDrawSurface.Bitmap.Canvas.BeginScene;
  try

    case FShapeToDraw of
      doLine:
      begin
        // restore canvas to initial state so we don't keep old movement data around
        R.TopLeft := PointF(0.0, 0.0);
        R.BottomRight := PointF(FDrawSurface.Width, FDrawSurface.Height);
        FDrawSurface.Bitmap.Canvas.DrawBitmap(FTempDrawBitmap, R, R, 100);
        FDrawSurface.Bitmap.Canvas.RestoreState(FDrawState);
        FDrawSurface.Bitmap.Canvas.DrawLine(PointF(TopLeft.X, TopLeft.Y), PointF(BottomRight.X, BottomRight.Y), 100);
      end;
    end;
  finally
    FDrawSurface.Bitmap.Canvas.EndScene;
    FDrawSurface.Bitmap.BitmapChanged;
  end;

end;

それは機能しますが、それが「正しい」方法であるかどうかはわかりません...

delphi - FireMonkey PenMode に相当するもの - DrawLine

2 に答える 2

Related

Reference