BillsEditor/MF/ScProgressFrm.pas

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

    单元说明： 新进度条。支持多种进度显示方式。包括：
               ①按步距增加进度方式(AddProgressForm方法)
               ②直接指定进度位置方式(RefreshProgressForm方法)

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


unit ScProgressFrm;

interface

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

type
  TProgressForm = class(TForm)
    Shape1: TShape;
    Gauge1: TGauge;
    lblTitle: TLabel;
    lblComplete: TLabel;
    lblShowProgress: TLabel;
    lblMessage: TLabel;
    lblNeedTime: TLabel;
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

procedure CreateProgressForm(AMaxValue: Integer; ATitle: string = '正在处理，请稍候>>>');
procedure RefreshProgressForm(APosition: Integer; AText: string); overload;
procedure RefreshProgressForm(AText: string); overload;
procedure RefreshProgressForm(APosition: Integer); overload;
// 显示大概需要多少时间。ARecordCount: 记录数
procedure RefreshProgressTime(ARecordCount: Integer);
procedure AddProgressForm(ACount: Integer; AText: string = '');

procedure CloseProgressForm(Delay: Boolean = True);

// 该方法是旧版本所有，为保证正常调用，保留该方法
procedure ShowFloatProgress(Text: string; Position: Integer);
procedure CloseFloatProgress;

var
  ProgressForm: TProgressForm = nil;

const
  sc_DragMove = $f012;

implementation

uses ScUtils;

{$R *.dfm}

procedure CreateProgressForm(AMaxValue: Integer; ATitle: string);
begin
  if (ProgressForm = nil) or (ProgressForm.Gauge1 = nil) then
    ProgressForm := TProgressForm.Create(nil);
  ProgressForm.lblTitle.Caption := ATitle;
  ProgressForm.Gauge1.MaxValue := AMaxValue;
  ProgressForm.Gauge1.Progress := 0;
  ProgressForm.Show;
  ProgressForm.Update;
end;

procedure RefreshProgressForm(APosition: Integer; AText: string);
begin
  if ProgressForm = nil then exit;
  with ProgressForm do
  begin
    Gauge1.Progress := APosition;
    lblShowProgress.Caption := IntToStr(Gauge1.PercentDone) + '%';
    lblMessage.Caption := AText;
    Update;
  end;
end;

procedure RefreshProgressForm(AText: string);
begin
  if ProgressForm = nil then exit;
  ProgressForm.lblMessage.Caption := AText;
  ProgressForm.Update;
end;

procedure RefreshProgressForm(APosition: Integer); 
var sPercent: string;
begin
  if ProgressForm = nil then exit;
  with ProgressForm do
  begin
    Gauge1.Progress := APosition;
    lblShowProgress.Caption := IntToStr(Gauge1.PercentDone) + '%';
    Update;
  end;
end;

procedure AddProgressForm(ACount: Integer; AText: string);
var sPercent: string;
begin
  if ProgressForm = nil then exit;
  with ProgressForm do
  begin
    Gauge1.Progress := Gauge1.Progress + ACount;
    if Gauge1.Progress >= Gauge1.MaxValue then
    begin
      Gauge1.Progress := Gauge1.Progress - Gauge1.MaxValue;
      if Gauge1.Progress = 0 then
        Gauge1.Progress := 10;
    end;

    lblShowProgress.Caption := IntToStr(Gauge1.PercentDone) + '%';
    if AText <> '' then
      lblMessage.Caption := AText;
    Update;
  end;
end;

// 1000行 大概需要3分钟 2000行需要6分钟
procedure RefreshProgressTime(ARecordCount: Integer);
var n: Integer;
begin
  with ProgressForm do
  begin
    n := Round(ARecordCount * 3 / 1000);

    if n >= 1 then
    begin
      lblNeedTime.Caption := Format('预计耗时%d分钟，请勿强行关闭或进行其它操作', [n]);
      lblNeedTime.Visible := True;
    end
    else
    begin
      lblNeedTime.Visible := False;
    end;
    lblNeedTime.Update;
  end;
end;


{ Delay: 关闭前是否要延迟200ms，有些地方如果不延迟，关得太快，感觉进度条没走完就关了，
 视觉效果不好。在批量克隆块到清单的时候，如果每处理一个就延迟200ms，会影响速度。}
procedure CloseProgressForm(Delay: Boolean);
begin
  if ProgressForm <> nil then
  begin
    if (ProgressForm.Gauge1.Progress <> ProgressForm.Gauge1.MaxValue)
      or (ProgressForm.lblMessage.Caption <> '已完成。') then
      RefreshProgressForm(ProgressForm.Gauge1.MaxValue, '已完成。');
    if Delay then
      Sleep(200);

    FreeAndNil(ProgressForm);
  end;
end;

procedure ShowFloatProgress(Text: string; Position: Integer);
begin
  if ProgressForm = nil then
    ProgressForm := TProgressForm.Create(nil);
  ProgressForm.lblMessage.Caption := Text;
  ProgressForm.Gauge1.Progress := Position;
  ProgressForm.lblShowProgress.Caption := IntToStr(ProgressForm.Gauge1.PercentDone) + '%';
  ProgressForm.Show;
  ProgressForm.Update;
end;

procedure CloseFloatProgress;
begin
  CloseProgressForm;
end;

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


end.