{*******************************************************************************
    单元名称： mProgressFrm.pas

    单元说明： 简单的进度提示窗。

    作者时间： Chenshilong, 2011-08-25
*******************************************************************************}


unit mProgressFrm;

interface

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

type
  TmProgress = class(TForm)
    shpProgress: TShape;
    lblMessage: TLabel;
    gaProgress: TGifAnimator;
    procedure shpProgressMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

procedure CreateProgress(AText: string);
procedure RefreshProgress(AText: string);
procedure CloseProgress;


implementation

uses ScUtils;

var
  mProgress: TmProgress = nil;

const
  sc_DragMove = $F012;

{$R *.dfm}


procedure Delay(Ams: Longint);
var
  Time1, Time2: Longint;
begin
  Time1 := GetTickCount();
  repeat
    Application.ProcessMessages;
    Time2 := GetTickCount();
  until (Time2 - Time1 >= Ams) or (Time2 < Time1);
end;

procedure CreateProgress(AText: string);
begin
  Screen.Cursor := crHourGlass;
  if mProgress = nil then
    mProgress := TmProgress.Create(nil);
  mProgress.lblMessage.Caption := AText;
  mProgress.Show;
  mProgress.Update;
  mProgress.gaProgress.Animate := True;
end;

procedure RefreshProgress(AText: string);
begin
  if mProgress = nil then Exit;
  mProgress.lblMessage.Caption := AText;
  mProgress.Update;
end;

procedure CloseProgress;
begin
  if Assigned(mProgress) then
  begin
    Delay(300);
    if mProgress <> nil then
      mProgress.gaProgress.Animate := False;
    FreeAndNil(mProgress);
  end;
  Screen.Cursor := crDefault;
end;

procedure TmProgress.shpProgressMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  (mProgress as TWinControl).PerForm(wm_SysCommand, sc_DragMove, 0);
end;


end.