delphi跨平台线程等待动画

在Delphi Firemonkey中使用Thread

查看更多关于 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.

 来源：https://www.amingstudio.com/delphi/574.html