Delphi中不用Animate組件顯示Fade效果中的FireMonkey窗體的簡單方法

unit uFormMain;

interface

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

type
  TfrmFormMain = class(TForm)
    btnCallFormSecond: TButton;
    Layout1: TLayout;
    btnHowManyFormsCreated: TButton;
    procedure btnCallFormSecondClick(Sender: TObject);
    procedure btnHowManyFormsCreatedClick(Sender: TObject);
  private
  public
  end;

var
  frmFormMain: TfrmFormMain;

implementation

{$R *.fmx}

uses
  uFormSecond;

procedure TfrmFormMain.btnCallFormSecondClick(Sender: TObject);
begin
  //
  btnCallFormSecond.Enabled := False; // avoid create anothers forms here! But dont worry = click many times to test!
  //
  frmFormSecond := TfrmFormSecond.Create(self);
  try
    Layout1.AddObject(frmFormSecond.Layout1);
    // frmFormSecond.Show; {not needs}
  finally
  end;
end;

procedure TfrmFormMain.btnHowManyFormsCreatedClick(Sender: TObject);
var
  i          : integer;
  sFormsCreateOnMemory: string;
begin
  for I          := 0 to (Screen.FormCount - 1) do
    sFormsCreateOnMemory := sFormsCreateOnMemory + Screen.Forms[i].ToString + #13#10;
  //
  ShowMessage(sFormsCreateOnMemory);
end;

end.
//----------//

unit uFormSecond;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Dialogs,
  FMX.Ani,
  FMX.Controls.Presentation,
  FMX.StdCtrls,
  FMX.ScrollBox,
  FMX.Memo,
  FMX.Objects,
  FMX.Layouts,
  FMX.ListBox,
  FMX.Edit;

type
  TfrmFormSecond = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    Edit1: TEdit;
    btnCloseMe: TButton;
    ListBox1: TListBox;
    Layout1: TLayout;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnCloseMeClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    iMyOpacityCount: Single;
  public
  end;

var
  frmFormSecond: TfrmFormSecond;

implementation

{$R *.fmx}

procedure TfrmFormSecond.btnCloseMeClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmFormSecond.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := TCloseAction.caFree;
end;

procedure TfrmFormSecond.FormCreate(Sender: TObject);
begin
  // Self.Visible      := False;
  Self.Transparency := True;          // start transparent!!!
  Self.BorderStyle  := TFmxFormBorderStyle.None; // no borders!
  //
  Panel1.Opacity  := 0;   // like a transparen!!!
  Timer1.Interval := 100; // 01 sec Div 100 = delay-time to show my form!
  iMyOpacityCount := 0.3; // intervale to opacity!!!
end;

procedure TfrmFormSecond.Timer1Timer(Sender: TObject);
begin
  Panel1.Opacity := Panel1.Opacity + iMyOpacityCount;
  //
  Edit1.Text := TimeToStr(now) + ', ' + Panel1.Opacity.ToString;
  //
  // Single type Use this type for low accuracy floating-point operations!!!
  // if Panel1.Opacity > 1 then ... dont disable my timer!!!
  if Panel1.Opacity > 0.999 then // 0.99 can solve problem with "accuracy" compare
  begin
    Timer1.Enabled := false;
    Edit1.Text     := 'Timer disabled!';
    //
    // Self.Transparency := False; // <---
    // Self.Visible := True;
    //
    Exit;
  end;
end;

end.

以上代碼頸椎枕Delphi 10.3.3 RIO中通過，歡迎加入Delphi知識局QQ羣:32422310