migratooor/progress.pas at main · svanas/migratooor · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
unit progress;

interface

uses
  // Delphi
  System.Classes,
  System.UITypes,
  // FireMonkey
  FMX.Controls,
  FMX.Controls.Presentation,
  FMX.Forms,
  FMX.StdCtrls,
  FMX.Types;

type
  TfrmProgress = class(TForm)
    btnCancel: TButton;
    indicator: TAniIndicator;
    lblMessage: TLabel;
    procedure btnCancelClick(Sender: TObject);
  private
    FCancelled: Boolean;
  protected
    procedure DoShow; override;
    procedure DoHide; override;
  public
    function Prompt(const msg: string): TModalResult;
    procedure Step(const msg: string; idx, cnt: Integer);
    property Cancelled: Boolean read FCancelled;
  end;

function Get(aOwner: TForm): TfrmProgress;

implementation

{$R *.fmx}

uses
  // Delphi
  System.SysUtils;

var
  frmProgress: TfrmProgress = nil;

function Get(aOwner: TForm): TfrmProgress;
begin
  if not Assigned(frmProgress) then
    frmProgress := TfrmProgress.Create(aOwner);
  Result := frmProgress;
end;

procedure TfrmProgress.btnCancelClick(Sender: TObject);
begin
  FCancelled := True;
end;

procedure TfrmProgress.DoShow;
begin
  indicator.Enabled := True;
  inherited DoShow;
end;

procedure TfrmProgress.DoHide;
begin
  FCancelled := False;
  inherited DoHide;
  indicator.Enabled := False;
end;

function TfrmProgress.Prompt(const msg: string): TModalResult;
begin
  lblMessage.Text := msg;
  Result := Self.ShowModal;
end;

procedure TfrmProgress.Step(const msg: string; idx, cnt: Integer);
begin
  lblMessage.Text := Format(msg, [idx, cnt]);
end;

end.