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.