ProgressBox

ProgressBox

Källkod

Nedan följer den kod som använts till detta exempel.

unit ProgressBox;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, Gauges, StdCtrls;

type
 TProgressForm = class(TForm)
   btnCancel: TButton;
   ProgressBar: TGauge;
   TheText: TLabel;
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure btnCancelClick(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;
 
 procedure StartProgress(ACaption, Text: String;
                 AMax: Integer; AColor: TColor);
 procedure ChangeProgress(AProgress: Integer; Text: String);
 
var
 ProgressForm: TProgressForm;
 Created: Bool = False;
  
implementation
  
{$R *.dfm}
  
procedure StartProgress(ACaption, Text: String;
               AMax: Integer; AColor: TColor);
begin
  If not Created then
  begin
    ProgressForm := TProgressForm.Create(Application);
    ProgressForm.Caption := ACaption;
    ProgressForm.ProgressBar.MaxValue := AMax;
    ProgressForm.ProgressBar.ForeColor := AColor;
    ProgressForm.ProgressBar.Progress := 0;
    ProgressForm.TheText.Caption := Text;
    ProgressForm.Show;
    Created := True;
  end;
end;

procedure ChangeProgress(AProgress: Integer; Text: String);
begin
  If Created then
  begin
    ProgressForm.ProgressBar.Progress := AProgress;
    If ProgressForm.ProgressBar.PercentDone = 100 then
    begin
      ProgressForm.Close;
      ShowMessage(Text);
    end;
  end;
end;

procedure TProgressForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Created := False;
  Action := caFree;
end;

procedure TProgressForm.btnCancelClick(Sender: TObject);
begin
  Close;
end;

end.