Pfeil auf einem Image platzieren

[fisipjm]

Zitat von Sinspin:

Zeig mal was du hast. Vermutlich siehst du nur gerade den Wald vor lauter Bäumen nicht.

Moin Sinspin,

ich habe das Wochenende genutzt und mich nochmal neu sortiert. Ich glaube mein Ansatz war maximal zu kompliziert. Ich hab dein Projekt nochmal angepasst und arbeite nicht mehr mit unterschiedlichen ebenen, sondern arbeite direkt auf dem Image1.Bitmap.Canvas. Habe mittlerweile auch verstanden, dass Image1.Canvas und Image1.Bitmap.Canvas nicht das selbe sind. Könntest du den Code nochmal kurz überfliegen, ob dir etwas einfällt wo du sagen würdest, mach das auf keinen Fall so.

Merci

Delphi-Quellcode:

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.