2

我在玩 FireMonkey 只是为了测试一些东西。其中之一是在画布上实现“非常简单”的绘图。例如直线、矩形等...

第一个问题是，是否有为 VCL for FireMonkey 提供的 graphex 演示的等价物？

否则，出于练习的目的，我正在尝试在 FireMonkey 中复制该演示，以及刚才的线条图。当我在预期的线条画周围移动鼠标时，我可以让线条图正常工作。不幸的是，我无法让它自动擦除在鼠标所在位置绘制的旧线。这似乎由 TPen 属性的 TPenMode 属性处理，据我所知，它是 FireMonkey 中的 TStroke 属性。即在绘制（移动鼠标）时将属性设置为 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 是一个 TPoint，它包含鼠标在 TImaeg 的 OnMouseDown 事件中捕获的位置的 X 和 Y，BottomRight 是来自 OnMouseMove 事件的当前 X 和 Y 坐标。

所以每次我移动鼠标时，我的图像上都会出现“附加”行。

谢谢

4

2 回答 2

4

AFAIK，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.
于 2012-04-24T21:59:36.523 回答
2

我最终所做的 - 基于上述 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;

它有效，但我不知道这是否是“正确”的方式......

于 2012-04-25T23:55:27.843 回答