在 Delphi 中使用 Firemonkey 淡入/淡出 2 种形式答案

【问题标题】：Fading in/out of 2 forms parallel in Delphi with Firemonkey在 Delphi 中使用 Firemonkey 淡入/淡出 2 种形式
【发布时间】：2022-01-16 18:27:31
【问题描述】：

我有一个在 Windows 10 上运行的 Delphi 10.4.2 FMX 应用程序，其中有 2 种图像在其中移动。两者都在彼此之上。我想慢慢淡出表格1并同时淡入表格2。有解决办法吗？

【问题讨论】：

很抱歉，FMX 表单没有Opacity 属性可以实现这一点。
但是，TFrame 具有 Opacity 属性，因此如果您可以使用一个表单和两个框架（每个框架都包含您为这两个表单考虑的组件）。然后你可以有一种形式，但有两种不同的内部，你可以在它们之间淡入淡出。我以前没有这样做过，但是编辑您的问题并包含表单的.pas 和.fmx 文件，这样我可以尝试一下。
要包含的代码行太多。我必须建立一个简单的例子。我尝试使用两个 TScaledLayout 并只使其中一个可见。它正在运行，但也有很多工作。并行我尝试使用 Remy Lebeau 的建议。

标签： delphi firemonkey fadein fadeout

【解决方案1】：

FMX 表单本身并不支持您的要求。

但是，当在 Windows 上运行时，窗体确实分配有 Win32 HWND（您可以使用 FMX.Platform.Win.FormToHWND() 获得）。因此，您可以使用 Win32 API SetLayeredWindowAttributes() 函数手动为窗口分配半透明值。

【讨论】：

要使 SetLayeredWindowAttributes() 起作用，表单必须将 Transparency 设置为 true，并且 Fill.Color 必须包含 TColorAnimation。对于淡入，可以，但对于淡出，必须分配一个新的 TColorAnimation。它在程序中是如何工作的？
TColorAnimation 只为表单设置半透明，而不为对象设置半透明。 SetLayeredWindowAttributes 停止当前的 onTimer 活动。所以运动图像停止。有什么解释吗？
@PeterKloß "SetLayeredWindowAttributes 停止当前的 onTimer 活动" - 它不应该对计时器产生任何影响。除非您使用的是基于窗口的计时器，并且在应用属性时窗口正在被销毁。
请试试我的示例程序。 Label1 的移动在按下 Button1 后停止。你可以在kloss.solutions/public/FadeInOut找到源代码
@PeterKloß 我无法尝试（现在没有安装 Delphi）所以我无法评论它为什么停止工作，但我会说在阻塞循环中使用 Application.ProcessMessages()不是处理您正在做的事情的最佳方法。在 VCL 中已经够危险了，在 FMX 中更是如此。相反，我建议打破循环并重用TTimer1，或使用TThread.ForceQueue() 并指定延迟。不要永远阻塞主 UI 线程。

【解决方案2】：

这很容易做到。在下面的代码中，我创建了两个表单，每个表单都将透明度设置为 True。每个都有一个由客户端对齐的 TLayout。每个 TLayout 都有一个 TImageControl。我选择 TImageControl 只是因为它有一个 LoadFromFile 方法，可以让这个演示变得简单。您可以改用不同的图像控件。（TImageControl 确实有一个您可能不想看到的边框。） TLayouts 的原因是因为我想要一个用于演示的 OnClick 处理程序，但是单击 TImageControl 会打开一个打开文件对话框。所以我不得不在 TImageControl 上将 HitTest 设置为 False，并让 TLayouts 来处理鼠标点击。使用不同的图像控件，您应该可以不用 TLayouts。

第一个表单有一个 TFloatAnimation 链接到 TLayout 的 Opacity 属性。 TFloatAnimation 的 OnProgress 事件会更新另一个窗体上 TLayout 的不透明度。

单击表单触发淡出/淡入。双击关闭应用程序。（需要有一些方法来关闭它，因为透明表单没有正常的关闭按钮。）

Form1 .fmx：

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form6'
  ClientHeight = 480
  ClientWidth = 680
  Transparency = True
  Visible = True
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  OnCreate = FormCreate
  DesignerMasterStyle = 0
  object Layout1: TLayout
    Align = Client
    HitTest = True
    Size.Width = 680.000000000000000000
    Size.Height = 480.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 0
    OnClick = Layout1Click
    OnDblClick = Layout1DblClick
    object ImageControl1: TImageControl
      Align = Client
      HitTest = False
      Size.Width = 680.000000000000000000
      Size.Height = 480.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 0
    end
    object FloatAnimation1: TFloatAnimation
      Duration = 2.000000000000000000
      OnProcess = FloatAnimation1Process
      OnFinish = FloatAnimation1Finish
      PropertyName = 'Opacity'
      StartValue = 1.000000000000000000
      StopValue = 0.000000000000000000
    end
  end
end

Form2 .fmx

object Form2: TForm2
  Left = 0
  Top = 0
  Caption = 'Form7'
  ClientHeight = 480
  ClientWidth = 680
  Transparency = True
  Visible = True
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  OnCreate = FormCreate
  DesignerMasterStyle = 0
  object Layout1: TLayout
    Align = Client
    HitTest = True
    Opacity = 0.000000000000000000
    Size.Width = 680.000000000000000000
    Size.Height = 480.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 0
    OnClick = Layoutl1Click
    OnDblClick = Layout1DblClick
    object ImageControl1: TImageControl
      Align = Client
      HitTest = False
      Size.Width = 680.000000000000000000
      Size.Height = 480.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 0
    end
  end
end

Form1 代码：

unit MainForm;

interface

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

type
  TForm1 = class(TForm)
    ImageControl1: TImageControl;
    FloatAnimation1: TFloatAnimation;
    Layout1: TLayout;
    procedure Layout1Click(Sender: TObject);
    procedure FloatAnimation1Process(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Layout1DblClick(Sender: TObject);
    procedure FloatAnimation1Finish(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

uses  FormTwo;

procedure TForm1.FloatAnimation1Finish(Sender: TObject);
begin
  FloatAnimation1.Inverse:=not FloatAnimation1.Inverse;
end;

procedure TForm1.FloatAnimation1Process(Sender: TObject);
begin
  if Assigned(Form2) then Form2.Layout1.Opacity:=1-Layout1.Opacity;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageControl1.LoadFromFile({your image path here});
end;

procedure TForm1.Layout1Click(Sender: TObject);
begin
  FloatAnimation1.Start;
end;

procedure TForm1.Layout1DblClick(Sender: TObject);
begin
  Application.Terminate;
end;

end.

Form2代码：

unit FormTwo;

interface

uses
  MainForm,
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Layouts;

type
  TForm2 = class(TForm)
    ImageControl1: TImageControl;
    Layout1: TLayout;
    procedure FormCreate(Sender: TObject);
    procedure Layoutl1Click(Sender: TObject);
    procedure Layout1DblClick(Sender: TObject);
  end;

var
  Form2: TForm2;

implementation

{$R *.fmx}

procedure TForm2.FormCreate(Sender: TObject);
begin
  Top:=Form1.Top;
  Left:=Form1.Left;
  IMageControl1.LoadFromFile({your image path here});
end;

procedure TForm2.Layoutl1Click(Sender: TObject);
begin
  Form1.FloatAnimation1.Start;
end;

procedure TForm2.Layout1DblClick(Sender: TObject);
begin
  Application.Terminate;
end;

end.

【讨论】：