FireMonkey PenMode эквивалент - DrawLine

Question

Я играю с FireMonkey просто, чтобы проверить пару вещей. Один из которых представляет собой «очень простой» рисунок на холсте. например, Line, Rectangle и т. д.

Первый вопрос: есть ли эквивалент демоверсии graphex для VCL для FireMonkey?

В противном случае, для целей упражнения, я пытаюсь воспроизвести эту демонстрацию в FireMonkey и только сейчас, рисунок линии. Я могу заставить рисунок линии работать так, как если бы я перемещал мышь вокруг линии, то рисовал там, где это ожидалось. К сожалению, я не могу заставить его автоматически стирать старую строку, которая была нарисована в предыдущей точке, где была мышь. По-видимому, это связано с свойством TPenMode свойства TPen, которое, насколько я могу судить, является свойством TStroke в FireMonkey. т.е. установка свойства pmXor во время рисования (перемещение мыши), а затем установка его на pmCopy по завершении.

Как бы я сделал что-то подобное с FireMonkey?

Вот процедура, которая вызывается при событии MouseMove в виде TImage:

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, который содержит X и Y, где мышь была как захват в событии OnMouseDown TImaeg и BottomRight - это текущие координаты X и Y из события OnMouseMove.

Так что каждый раз, когда я перемещаю мышь, я получаю «дополнительные» линии на моем изображении.

Благодаря

Answer 1

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. 

Answer 2

Что я на самом деле делал - основываясь на проницательности от Уайлера выше, сохранялось состояние растрового изображения в начале «рисованной процедуры» (т.е. на мыши вниз), а затем на 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; 

это работает, но я не знаю, если это «правильный» путь или нет ...