ProgressBox
Utseende
ProgressBox
Källkod
[redigera]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.