fmprogr.pas

来自「Delphi direct support for GIF files」· PAS 代码 · 共 71 行

unit FmProgr;
{ Exports procedure ShowProgress, which can show a small window
with a Gauge in it. This procedure can be used in conjunction with
unit Progres.

 4 Dec 96: - Put variable ProgessForm in implementation
           - now ProgressForm is created in the initialization
 9 Dec 96: - Put variable PorgessForm in interface again, to make
             it possible to access its caption
 6 Mar 97: - improved TProgressForm.ShowProgress slightly (more robust now)
 3 Nov 97: - added ProgressForm.Free in finalization
 9 Nov 97: - ifdef'd that statement out for Delphi 1
12 Dec 97: - removed the initialization/finalization section;
             check on existence of ProgressForm now added in
             unit Progres
}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Gauges;

type
  TProgressForm = class(TForm)
    Gauge1: TGauge;
  private
    { Private declarations }
    procedure ShowProgress(frac: Single);
  public
    { Public declarations }
  end; { TProgressForm }

procedure ShowProgress(frac: Single);

var
  ProgressForm: TProgressForm;

implementation

{$R *.DFM}

procedure TProgressForm.ShowProgress(frac: single);
begin { TProgressForm.ShowProgress }
  if frac > 0.9999
  then Visible := False
  else begin
    if not Visible
    then Visible := True;
    Gauge1.progress := Round(frac*100);
  end;
end;  { TProgressForm.ShowProgress }

{$F+}
procedure ShowProgress(frac: Single);
begin
  if not Assigned(ProgressForm)
  then ProgressForm := TProgressForm.Create(nil);
  ProgressForm.ShowProgress(frac);
  Application.ProcessMessages;
end;
{$F-}

(*initialization
  ProgressForm := TProgressForm.Create(nil);
{$ifndef ver80}
finalization
  ProgressForm.Free;
{$endif ver80}*)
end. { unit FmProgr }