我在玩FireMonkey只是为了测试一些事情。其中之一是在画布上实现“非常简单”的绘图。例如线,矩形等...
第一个问题是,是否有为FireMonkey的VCL提供的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坐标。
因此,每次移动鼠标时,图像上都会出现“附加”线条。
谢谢
最佳答案
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.
关于delphi - 相当于FireMonkey PenMode-DrawLine,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/10291330/