showprogress.pas

来自「群星医药系统源码」· PAS 代码 · 共 77 行

unit ShowProgress;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  StdCtrls, ExtCtrls, Forms, ComCtrls;

type
  TFmProgress = class(TForm)
    Animate1: TAnimate;
    LblShow: TLabel;
    Shape1: TShape;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    bRealClose: Boolean;
  public
    procedure RealClose;
  end;

var
  FmProgress: TFmProgress;

procedure SetGressHint(sHint: String);
procedure FreeGressForm;

implementation

{$R *.DFM}

procedure SetGressHint(sHint: String);
begin
  if not Assigned(FmProgress) then begin
    FmProgress := TFmProgress.Create(Application);
    FmProgress.Show;
  end;
  FmProgress.LblShow.Caption := sHint;
  FmProgress.LblShow.Update;
end;

procedure FreeGressForm;
begin
  if Assigned(FmProgress) then begin
    FmProgress.RealClose;
    FreeAndNil(FmProgress);
  end;
end;

procedure TFmProgress.RealClose;
begin
  bRealClose := true;
  Close;
end;

procedure TFmProgress.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose := bRealClose;
  Inherited;
end;

procedure TFmProgress.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Hide;
end;

initialization

finalization
  if Assigned(FmProgress) then
    FreeGressForm;

end.