匿名线程中的 TFloatAnimation。线程不会死，动画不会重启

Question

我已经为此苦苦挣扎了一两天，但在任何地方都找不到答案。我以为this answer might help但没有。

在下面的示例代码中，我有两个 Timage 组件，每个组件都包含一个 "Start Image"。单击 "Start Button" 时会创建两个匿名线程，一个在起始图像和结束图像之间为 Image1 设置动画，另一个为 Image2.

执行相同的操作

我的问题是，当 KillAnimation 布尔值设置为 True 时，两个动画都应该停止（它们会停止），但只有一个线程退出，另一个停止动画但是在动画中离开图像。

如果我也使用预定义的线程，我也会遇到同样的问题。

示例应用程序只有两个图像，真实世界的应用程序可以有 15 到 24 个。匿名线程似乎很适合，因为我可以创建它们并且不必担心定义多达 24 个 TThreads。我希望这是有道理的。

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics,  FMX.Objects,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Ani, FMX.Effects,
  FMX.Filter.Effects;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    BtnStop: TButton;
    BtnStart: TButton;
    BtnReset: TButton;
    procedure BtnStopClick(Sender: TObject);
    procedure BtnStartClick(Sender: TObject);
    procedure BtnResetClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure createthread(TheImage: TImage; TargetBMP: String);
  end;

var
  Form1: TForm1;
  KillAnimation: Boolean;

implementation

{$R *.fmx}

procedure TForm1.BtnStopClick(Sender: TObject);
begin
  KillAnimation := true;
end;

procedure TForm1.createthread(TheImage: TImage; TargetBMP: String);
begin
  { The thread works right up until it is stopped. Even though two
    threads are started only one finishes. In addition, the images
    do not end up as the target image, and neither image can be
    reset even if I reload them from files. }

  TThread.CreateAnonymousThread(
    procedure()
    var
      Wiggle: TWiggleTransitionEffect;
      TheFloat: TFloatAnimation;
    begin
      TThread.NameThreadForDebugging('Animate ' + TheImage.Name);
      Wiggle := TWiggleTransitionEffect.Create(Nil);
      Wiggle.RandomSeed := 0.3;
      Wiggle.Progress := 0;
      Wiggle.Parent := TheImage;

      TThread.Synchronize(TThread.CurrentThread,
        procedure()
        Begin
          Wiggle.Target.LoadFromFile(TargetBMP)
        end);

      TheFloat := TFloatAnimation.Create(Nil);
      TheFloat.Parent := Wiggle;
      TheFloat.PropertyName := 'Progress';
      TheFloat.Duration := 2;
      TheFloat.AutoReverse := true;
      TheFloat.Loop := true;
      TheFloat.StartValue := 0;
      TheFloat.StopValue := 100;
      TheFloat.StartFromCurrent := false;
      TheFloat.start;

      while not KillAnimation do
        application.handlemessage;

      TheFloat.stop;
    end).start;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  Image1.Bitmap.LoadFromFile('c:\sample\startimage.png');
  Image2.Bitmap.LoadFromFile('c:\sample\startimage.png');

end;

procedure TForm1.BtnStartClick(Sender: TObject);
begin
  KillAnimation := false;
  createthread(Image1, 'c:\sample\endimage.png');
  createthread(Image2, 'c:\sample\endimage.png');

end;

procedure TForm1.BtnResetClick(Sender: TObject);
begin
  KillAnimation := false;
  Image1.Bitmap.LoadFromFile('c:\sample\startimage.png');
  Image2.Bitmap.LoadFromFile('c:\sample\startimage.png');
end;

end.

我原以为在线程中创建 Transition 和 FloatAnimation 意味着它们在完成后会被销毁，因为 FreeOnTerminate 为 True。

当我尝试使用 "image1.bitmap.loadfromfile" 重置图像时，它没有改变。

图片为 170 x 170 png 文件。

我做错了什么？

我的目标是将 TImage 和一个图像文件传递给线程，让它保持动画直到被告知停止。我不太可能需要所有 24 张图像来制作动画，但你永远不知道。

抱歉，我不应该发布示例中的所有代码。至少你能看到一切。

Answer 1

你根本不应该为此使用线程。 UI 元素（包括视觉效果）应仅在主 UI 线程中使用。除非您正在为移动平台开发应用程序，否则对象在超出范围时不会自动销毁，您必须在使用完它们后自行销毁它们，或者为它们分配一个 Owner 来为您销毁它们。

试试这个：

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Objects, FMX.Controls.Presentation,
  FMX.StdCtrls, FMX.Ani, FMX.Effects, FMX.Filter.Effects;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    BtnStop: TButton;
    BtnStart: TButton;
    BtnReset: TButton;
    procedure BtnStopClick(Sender: TObject);
    procedure BtnStartClick(Sender: TObject);
    procedure BtnResetClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    Float1: TFloatAnimation;
    Float2: TFloatAnimation;
    function PrepareEffect(TheImage: TImage; const TargetBMP: String): TFloatAnimation;
    procedure ResetImages;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.BtnResetClick(Sender: TObject);
begin
  ResetImages;
end;

procedure TForm1.BtnStartClick(Sender: TObject);
begin
  Float1.start;
  Float2.start;
end;

procedure TForm1.BtnStopClick(Sender: TObject);
begin
  Float1.stop;
  Float2.stop;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ResetImages;
  Float1 := PrepareEffect(Image1, 'c:\sample\endimage.png');
  Float2 := PrepareEffect(Image2, 'c:\sample\endimage.png');
end;

function TForm1.PrepareEffect(TheImage: TImage; const TargetBMP: String): TFloatAnimation;
var
  Wiggle: TWiggleTransitionEffect;
  TheFloat: TFloatAnimation;
begin
  Wiggle := TWiggleTransitionEffect.Create(Self);
  Wiggle.RandomSeed := 0.3;
  Wiggle.Progress := 0;
  Wiggle.Parent := TheImage;
Wiggle.Target.LoadFromFile(TargetBMP);

  TheFloat := TFloatAnimation.Create(Self);
  TheFloat.Parent := Wiggle;
  TheFloat.PropertyName := 'Progress';
  TheFloat.Duration := 2;
  TheFloat.AutoReverse := true;
  TheFloat.Loop := true;
  TheFloat.StartValue := 0;
  TheFloat.StopValue := 100;
  TheFloat.StartFromCurrent := false;

  Result := TheFloat;
end;

procedure TForm1.ResetImages;
begin   
  Image1.Bitmap.LoadFromFile('c:\sample\startimage.png');
  Image2.Bitmap.LoadFromFile('c:\sample\startimage.png');
end;

end.

匿名线程中的 TFloatAnimation。线程不会死，动画不会重启

TFloatAnimation within anonymous thread. Thread wont die and animation wont restart

delphi

animation

multithreading

delphi-10.2-tokyo