unit FMX_PaintFrm;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.UIConsts, System.Classes, System.Variants, System.Math,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, FMX.Controls.Presentation, FMX.Objects;
type
TForm1 =
class(TForm)
btn_save: TButton;
Image1: TImage;
btn_Turn: TButton;
btn_prev: TButton;
procedure btn_prevClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btn_saveClick(Sender: TObject);
procedure btn_TurnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
private
{ Private declarations }
ImageToBitmapFactorWidth: Single;
ImageToBitmapFactorHeight: Single;
Down: Boolean;
ImageState: Tarray<TBitmap>;
ImageStateStage: Integer;
procedure AppendNewState;
procedure DrawArrow(Canvas: TCanvas; X1, Y1, X2, Y2: Single; LineSize: Integer; aColor: TAlphaColor);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.DrawArrow(Canvas: TCanvas; X1, Y1, X2, Y2: Single; LineSize: Integer; aColor: TAlphaColor);
var
Angle: Double;
X, Y: Single;
lBrush: TStrokeBrush;
begin
lBrush := TStrokeBrush.Create(TBrushKind.Solid, aColor);
try
lBrush.Thickness := LineSize;
lBrush.Cap := TStrokeCap.Round;
lBrush.Color := aColor;
Canvas.DrawLine(TPointF.Create(X1, Y1), TPointF.Create(X2, Y2), 100, lBrush);
Angle := ArcTan2(Y2 - Y1, X2 - X1);
X := X2 - (20 * Cos(Angle - Pi / 6));
Y := Y2 - (20 * Sin(Angle - Pi / 6));
Canvas.DrawLine(TPointF.Create(X2, Y2), TPointF.Create(X, Y), 100, lBrush);
X := X2 - (20 * Cos(Angle + Pi / 6));
Y := Y2 - (20 * Sin(Angle + Pi / 6));
Canvas.DrawLine(TPointF.Create(X2, Y2), TPointF.Create(X, Y), 100, lBrush);
finally
lBrush.Free;
end;
end;
procedure TForm1.btn_prevClick(Sender: TObject);
begin
if ImageStateStage = 0
then
if High(ImageState) = -1
then
exit
else
ImageStateStage := High(ImageState);
Inc(ImageStateStage, -1);
Image1.Bitmap.Canvas.BeginScene;
try
Image1.Bitmap.Canvas.DrawBitmap(ImageState[ImageStateStage], ImageState[ImageStateStage].BoundsF, Image1.Bitmap.BoundsF, 1.0, true);
finally
Image1.Bitmap.Canvas.EndScene;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
lBitmap: TBitmap;
begin
for lBitmap
in ImageState
do
lBitmap.Free;
end;
procedure TForm1.btn_saveClick(Sender: TObject);
begin
Image1.Bitmap.SaveToFile('
C:\Users\Administrator\Desktop\BetterCallSaul.jpg');
end;
procedure TForm1.btn_TurnClick(Sender: TObject);
begin
Image1.Bitmap.Rotate(90);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
AppendNewState;
ImageToBitmapFactorWidth := Image1.Bitmap.Width / Image1.Width;
ImageToBitmapFactorHeight := Image1.Bitmap.Height / Image1.Height;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
Down := true;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
var
LastImage: TBitmap;
begin
if Down
then
begin
LastImage := ImageState[high(ImageState)];
Image1.Bitmap.Canvas.BeginScene;
try
Image1.Bitmap.Canvas.DrawBitmap(LastImage, LastImage.BoundsF, Image1.Bitmap.BoundsF, 1.0, true);
DrawArrow(Image1.Bitmap.Canvas, Image1.PressedPosition.X * ImageToBitmapFactorWidth, Image1.PressedPosition.Y * ImageToBitmapFactorHeight,
X * ImageToBitmapFactorWidth, Y * ImageToBitmapFactorHeight, 4, TAlphaColors.Green);
finally
Image1.Bitmap.Canvas.EndScene;
end;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
Down := false;
AppendNewState;
end;
procedure TForm1.AppendNewState;
var
lBitmap: TBitmap;
begin
lBitmap := TBitmap.Create(Image1.Bitmap.Width, Image1.Bitmap.Height);
lBitmap.CopyFromBitmap(Image1.Bitmap);
ImageState := ImageState + [lBitmap];
end;
end.