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.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

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

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;

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.

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.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

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;

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;

FFundo := nil;

FAguarde := nil;

FAniLoading := nil;

FLabelMessage := nil;

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.

Delphi跨平台线程等待动画

介绍

主要代码

相关下载

Delphi获取文件创建时间、文件最后修改时间

Delphi制作手机签名app（windows同样适用）

参与评论

欢迎来到阿明工作室

阿明工作室专注软件及网络资源定制,免费软件,精品源码应有尽有

快速导航

Delphi跨平台线程等待动画

介绍

主要代码

相关下载

分享本文封面

相关文章

参与评论

欢迎来到阿明工作室

阿明工作室专注软件及网络资源定制,免费软件,精品源码应有尽有

登录

快速导航