uprogress.pas

来自「非长好的DELPHI办公系统 直接可以用」· PAS 代码 · 共 88 行

unit uProgress;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ComCtrls, Gauges;

type
  TProgress = class
  private
    { Private declarations }
    FForm: TForm;
    FGauge: TGauge;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent);
    destructor Destroy; override;
  published
    procedure Update;
  end;

procedure ShowProgress(AOwner: TComponent);

implementation

procedure ShowProgress(AOwner: TComponent);
var
  Progress: TProgress;
begin
  Progress := TProgress.Create(AOwner);
  Progress.Update;
  Progress.Free;
end;

{ TProgress }

constructor TProgress.Create(AOwner: TComponent);
begin
  if not Assigned(FForm) then
  begin
    FForm := TForm.Create(AOwner);
    with FForm do
    begin
      FormStyle := fsStayOnTop;
      AlphaBlend := True;
      AlphaBlendValue := 75;
      BorderStyle := bsNone;
      Color := $00FFACAC;
      Position := poScreenCenter;
      AutoSize := True;
    end;
    FGauge := TGauge.Create(FForm);
    with FGauge do
    begin
      Parent := FForm;
      Width := 201;
      Height := 16;
      BackColor := $00FFACAC;
      ForeColor := clNavy;
    end;
  end;
end;

destructor TProgress.Destroy;
begin
  if Assigned(FGauge) then FreeAndNil(FGauge);
  if Assigned(FForm) then FreeAndNil(FForm);
  inherited;
end;

procedure TProgress.Update;
var
  i: Integer;
begin
  FForm.Show;
  FForm.Update;
  FGauge.Show;
  FGauge.Update;

  for i := 0 to 100 do
  begin
    FGauge.Progress := i;
    Sleep(5);
  end;
end;

end.