Delphi跨平台线程等待动画

介绍

在Delphi Firemonkey中使用Thread操作线程的图形界面。

主要代码

unit FormMain;

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;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    Button2: TButton;
    Button3: TButton;
    tmrThreadFim: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure tmrThreadFimTimer(Sender: TObject);
  private
    { Private declarations }
    var
      FThreadMessage: String;
      FThreadFim: Boolean;
    procedure MudarProgressBar();
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
Utils.Aguarde;

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
var
  vThread: TThread;
begin
  vThread := TThread.CreateAnonymousThread(procedure
  var
    i : Integer;
  begin
    try
      TThread.Synchronize(nil, procedure
      begin
        TAguarde.Show('加载中...');
        ProgressBar1.Value := 0;
      end);

      for i := 0 to 100 do
      begin
        TThread.Synchronize(nil, procedure
        begin
          ProgressBar1.Value := ProgressBar1.Value + 1;
        end);

        Sleep(50);
      end;
    finally
      if not TThread.CheckTerminated then
      TThread.Synchronize(nil, procedure
      begin
        TAguarde.Hide;
      end);
    end;
  end);
  vThread.FreeOnTerminate := True;
  vThread.Start;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  vThread: TThread;
begin
  TAguarde.Show('加载中...');

  FThreadMessage := '';
  FThreadFim := False;
  tmrThreadFim.Enabled := True;

  vThread := TThread.CreateAnonymousThread(procedure
  var
    i : Integer;
  begin
    try
    try
      TThread.Synchronize(nil, procedure
      begin
        //TAguarde.Show('加载中...');
        ProgressBar1.Value := 0;
      end);

      for i := 0 to 100 do
      begin
        TThread.Synchronize(nil, procedure
        begin
          ProgressBar1.Value := ProgressBar1.Value + 1;
        end);

        Sleep(50);
      end;
    except
      on E:Exception do
        FThreadMessage := '错误 - ' + E.Message;
    end;
    finally
      FThreadFim := True;
    end;
  end);
  vThread.FreeOnTerminate := True;
  vThread.Start;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  TAguarde.Show('加载中...');
  MudarProgressBar;
  TAguarde.Hide;
end;

procedure TForm1.MudarProgressBar;
var
    i : Integer;
begin
  TThread.Synchronize(nil, procedure
  begin
    ProgressBar1.Value := 0;
  end);

  for i := 0 to 100 do
  begin
    TThread.Synchronize(nil, procedure
    begin
      ProgressBar1.Value := ProgressBar1.Value + 1;
      TAguarde.ChangeMessage('已加载 ' + IntToStr(i) + ' /  100');
    end);

    Sleep(50);
  end;
end;

procedure TForm1.tmrThreadFimTimer(Sender: TObject);
begin
  if(FThreadFim)then
  begin
    tmrThreadFim.Enabled := False;
    FThreadFim := False;

    TAguarde.Hide;

    if not(FThreadMessage.IsEmpty) then
      ShowMessage(FThreadMessage);
  end;
end;

end.

unit Utils.Aguarde;

{****

Objetivo: servir como uma tela customizavel de Loading para apresentar ao usuario,
permitindo assim que alguma acao do App seja entendida como um processo a ser aguardado

Autor: Adriano Santos, do portal TDevRocks
****}

interface

uses
  System.UITypes,
  System.SysUtils,

  FMX.Types,
  FMX.Controls,
  FMX.StdCtrls,
  FMX.Objects,
  FMX.Forms,
  FMX.Effects,
  FMX.Layouts,
  FMX.Edit,
  FMX.Graphics,
  FMX.Dialogs;

type
  TAguarde = class
    private
      class var FAguarde      : TRectangle;
      class var FLytEdit      : TLayout;
      class var FFundo        : TPanel;
      class var FAniLoading   : TAniIndicator;
      class var FLabelMessage : TLabel;

      class procedure TrocaCorPFundo(Sender: TObject);
    public

      class procedure Show(const AMessage: string = '');
      class procedure ChangeMessage(const aMessage: string = '');
      class procedure Hide;
  end;

implementation

{ TAguarde }

class procedure TAguarde.ChangeMessage(const AMessage: string);
begin
  if (Assigned(FLabelMessage)) and(FLabelMessage <> nil) then
    try
      FLabelMessage.Text := AMessage;
    except

    end;
end;

class procedure TAguarde.Hide;
begin
  if (Assigned(FAguarde)) then
  begin
    FFundo.AnimateFloat('OPACITY', 0);
    FAguarde.AnimateFloatWait('OPACTIY', 0);

    try
      if Assigned(fAniLoading) then
        fAniLoading.DisposeOf;
      if Assigned(fLabelMessage) then
        fLabelMessage.DisposeOf;
      if Assigned(FFundo) then
        FFundo.DisposeOf;
      if Assigned(FAguarde) then
        FAguarde.DisposeOf;
    except on E:Exception do
      begin
        ShowMessage(E.Message);
      end;
    end;

    FFundo        := nil;
    FAguarde      := nil;
    FAniLoading   := nil;
    FLabelMessage := nil;
  end;
end;

class procedure TAguarde.Show(const AMessage: string);
begin

  FFundo                       := TPanel.Create(Application.MainForm);
  FFundo.Parent                := Application.MainForm;//AParent;
  FFundo.Visible               := True;
  FFundo.Align                 := TAlignLayout.Contents;
  FFundo.OnApplyStyleLookup    := TrocaCorPFundo;

  FAguarde                     := TRectangle.Create(Application.MainForm);
  FAguarde.Parent              := Application.MainForm;
  FAguarde.Visible             := True;
  FAguarde.Height              := 75;
  FAguarde.Width               := 275;
  FAguarde.XRadius             := 10;
  FAguarde.YRadius             := 10;
  FAguarde.Position.X          := (TForm(Application.MainForm).ClientWidth - FAguarde.Width) / 2;
  FAguarde.Position.Y          := (TForm(Application.MainForm).ClientHeight - FAguarde.Height) / 2;
  FAguarde.Stroke.Kind         := TBrushKind.None;

  FAniLoading                  := TAniIndicator.Create(Application.MainForm);
  FAniLoading.Visible          := False;
  FAniLoading.Enabled          := False;
  FAniLoading.Align            := TAlignLayout.Left;
  FAniLoading.Parent           := FAguarde;
  FAniLoading.Margins.Right    := 10;
  FAniLoading.Align            := TAlignLayout.MostRight;
  FAniLoading.Enabled          := True;
  FAniLoading.Visible          := True;

  with TLabel.Create(FAguarde) do
  begin
    Parent                     := FAguarde;
    Align                      := TAlignLayout.Top;
    Margins.Left               := 10;
    Margins.Top                := 10;
    Margins.Right              := 10;
    Height                     := 28;
    StyleLookup                := 'embossedlabel';
    Text                       := '请稍后！';
    Trimming                   := TTextTrimming.ttCharacter;
  end;

  FLabelMessage                := TLabel.Create(Application.MainForm);
  FLabelMessage.Parent         := FAguarde;
  FLabelMessage.Align          := TAlignLayout.Client;
  FLabelMessage.Margins.Left   := 10;
  FLabelMessage.Margins.Top    := 10;
  FLabelMessage.Margins.Right  := 10;
  FLabelMessage.Font.Size      := 12;
  FLabelMessage.StyledSettings := [TStyledSetting.ssFamily, TStyledSetting.ssStyle, TStyledSetting.ssFontColor];
  FLabelMessage.Text           := AMessage;
  FLabelMessage.VertTextAlign  := TTextAlign.taLeading;
  FLabelMessage.Trimming       := TTextTrimming.ttCharacter;

  with TShadowEffect.Create(FAguarde) do
  begin
    Parent                     := FAguarde;
    Enabled                    := True;
  end;

  FFundo.Opacity               := 0;
  FAguarde.Opacity             := 0;

  FFundo.Visible               := True;
  FAguarde.Visible             := True;

  FFundo.AnimateFloat('OPACITY', 0.5);
  FAguarde.AnimateFloatWait('OPACITY', 1);
  FAguarde.BringToFront;
  FAguarde.SetFocus;

end;

class procedure TAguarde.TrocaCorPFundo(Sender: TObject);
var
  Rectangle : TRectangle;
begin
  Rectangle := (Sender as TFmxObject).Children[0] as TRectangle;
  Rectangle.Fill.Color := TAlphaColors.Black;
end;

end.

相关下载

点击下载