Вращающийся образ в Delphi - PullRequest
1 голос
/ 11 июля 2020

Я тестирую, как вращать изображение в Delphi (на Android). Почему-то работает, только если двумя пальцами двигать по экрану. И вращение не плавное. В идеале, щелкнув изображение одним пальцем, я бы хотел, чтобы изображение вращалось до тех пор, пока оно не остановится другим щелчком. Кроме того, есть ли лучший способ добиться этого, более Delphi? У меня есть этот код (RAD Delphi 10.4):

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  FMX.Colors, System.IOUtils, FMX.Gestures, System.Math, FMX.Media;

type
  TForm1 = class(TForm)
    ColorBox1: TColorBox;
    ColorBox2: TColorBox;
    ColorBox3: TColorBox;
    ColorBox4: TColorBox;
    ColorBox5: TColorBox;
    ColorBox6: TColorBox;
    Image1: TImage;
    GestureManager1: TGestureManager;
    MediaPlayer1: TMediaPlayer;
    procedure ColorBox1Click(Sender: TObject);
    procedure ColorBox2Click(Sender: TObject);
    procedure ColorBox3Click(Sender: TObject);
    procedure ColorBox4Click(Sender: TObject);
    procedure ColorBox5Click(Sender: TObject);
    procedure ColorBox6Click(Sender: TObject);
    procedure Image1Gesture(Sender: TObject; const EventInfo: TGestureEventInfo;
      var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}

procedure TForm1.ColorBox1Click(Sender: TObject);
var
  number: Integer;
  stop: Boolean;

begin
  //Image1.Bitmap.LoadFromFile('../../images/black.png')
  Image1.Bitmap.LoadFromFile(TPath.GetDocumentsPath + PathDelim + 'black.png');
  MediaPlayer1.FileName := TPath.Combine(TPath.GetDocumentsPath, 'spinner.3gp');
  MediaPlayer1.Play;
end;

procedure TForm1.ColorBox2Click(Sender: TObject);
begin
  //Image1.Bitmap.LoadFromFile('../../images/blue.png')
  Image1.Bitmap.LoadFromFile(TPath.GetDocumentsPath + PathDelim + 'blue.png');
end;

procedure TForm1.ColorBox3Click(Sender: TObject);
begin
  //Image1.Bitmap.LoadFromFile('../../images/red.png')
  Image1.Bitmap.LoadFromFile(TPath.GetDocumentsPath + PathDelim + 'red.png');
end;

procedure TForm1.ColorBox4Click(Sender: TObject);
begin
  //Image1.Bitmap.LoadFromFile('../../images/green.png')
  Image1.Bitmap.LoadFromFile(TPath.GetDocumentsPath + PathDelim + 'green.png');
end;

procedure TForm1.ColorBox5Click(Sender: TObject);
begin
  //Image1.Bitmap.LoadFromFile('../../images/yellow.png')
  Image1.Bitmap.LoadFromFile(TPath.GetDocumentsPath + PathDelim + 'yellow.png');
end;

procedure TForm1.ColorBox6Click(Sender: TObject);
begin
  //Image1.Bitmap.LoadFromFile('../../images/pink.png')
  Image1.Bitmap.LoadFromFile(TPath.GetDocumentsPath + PathDelim + 'pink.png');
end;

procedure TForm1.Image1Gesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
  var
    LObj: IControl;
    image: TImage;
begin
  LObj := Self.ObjectAtPoint(ClientToScreen(EventInfo.Location));
  if LObj is TImage then
  begin
    image := TImage(LObj.GetObject);
    image.RotationAngle := RadToDeg(-EventInfo.Angle);
  end;
end;

end.

1 Ответ

2 голосов
/ 11 июля 2020

Полагаю, лучше использовать событие OnClick TImage вместо Gesture.

const
  RotationDelta = 0.5;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Enabled := false; //to disable rotation
  Timer1.Interval := 20;
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
   Timer1.Enabled := not Timer1.Enabled; //Timer.Interval should be 20-30 ms
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Image1.RotationAngle := Image1.RotationAngle + RotationDelta; //rotate image
end;

Это не очень хорошая реализация, потому что TTimer не очень точен, но достаточно хорош для общих целей. Если вы хотите более медленное или быстрое вращение, вы должны соответственно изменить RotationDelta.

Но мой совет будет работать, только если вы хотите включить / отключить вращение, щелкнув изображение, а не при скольжении.

PS Проверил это решение на Delphi 10.1, но только на Windows.

...