ufrmwaiting.pas

ACCESS 数据库管理工具

unit ufrmWaiting;

interface

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

type
  TfrmWaiting = class(TForm)
    Timer1: TTimer;
    pnlTitle: TPanel;
    Gauge: TGauge;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmWaiting: TfrmWaiting;
procedure OpenWaiting(sCaption: string = '');
procedure CloseWaiting;
implementation

{$R *.dfm}

procedure OpenWaiting(sCaption: string = '');
begin
  if Assigned(frmWaiting) then
  begin
    frmWaiting.Close;
    FreeAndNil(frmWaiting);
  end;
  frmWaiting := TfrmWaiting.Create(nil);
  with frmWaiting do
  begin
    if sCaption <> '' then
      pnlTitle.Caption := sCaption;
    Show;
    Refresh;
  end;
end;

procedure CloseWaiting;
begin
  Application.ProcessMessages;
  if Assigned(frmWaiting) then
  begin
    frmWaiting.Close;
   //  frmWaiting.Free;
   //  frmWaiting :=nil;
    FreeAndNil(frmWaiting);
  end;
end;


procedure TfrmWaiting.FormShow(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
end;

procedure TfrmWaiting.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Screen.Cursor := crDefault;
  Action := cafree;
end;

procedure TfrmWaiting.Timer1Timer(Sender: TObject);
begin
  if Application.Active then
    BringToFront;
  Application.ProcessMessages;
end;

end.