unit uProgressBar;
{
***********************************************************************
* 即插即用的绿色代码 通用单进度条构件单元 Copyright(C) 月夜风筝 2007
* QQ-EMial: 14574256@163.com
* 创建时间：07-04-27
***********************************************************************
* 使用方法：(只2句代码)
* 1.在您模块中添加如下一句代码,即可启动进度条
* TfrmProgressBar.StartUp(标题，最大值);
* 注：若标题传空串，将为默认值"数据正在处理中，请您耐心等待．．．．．"
* 2.在进度增加了时候,请写如下一句代码
* frmProgressBar.IncProgress;
* 3.带有绝对值进度功能(相对于百分比),能看到终点值和当前值
* 4.当进度达到终点值时,进度条自己就会关闭,不需要干预
***********************************************************************
* @1.虽然使用了全局变量frmProgressBar，但不算严重违反设计模式,对于如何
* 得到简约强大class级别或constructor类型的 "StartUp",有高手请赐教!
* @2.本进度条使用Show的方式启动,在进度条走动期间,软件的其它部分仍然可
* 以响应用户操作,如何让软件此时停止响应(反正是不能用ShowModal)
***********************************************************************
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Gauges, StdCtrls;
type
TfrmProgressBar = class(TForm)
gg: TGauge;
lblCap: TLabel;
lblInf: TLabel;
private
public
{安装进度条，立即启动}
class procedure StartUp(const ACap: string; const AMax: Integer);
{增加进度,当进度完满时,自动关闭进度条}
procedure IncProgress;
end;
var
frmProgressBar: TfrmProgressBar;
implementation
{$R *.dfm}
{安装进度条，立即启动}
class procedure TfrmProgressBar.StartUp(const ACap: string; const AMax: Integer);
begin
frmProgressBar := TfrmProgressBar.Create(nil);
if ACap <> '' then
begin
frmProgressBar.lblCap.Caption := ACap;
end;
frmProgressBar.gg.MaxValue := AMax;
frmProgressBar.Show;
Application.ProcessMessages; {加上这句为了让窗体立即刷新}
end;
{增加进度,当进度完满时,自动关闭进度条}
procedure TfrmProgressBar.IncProgress;
begin
gg.AddProgress(1);
lblInf.Caption := Format('%0:d/%1:d', [gg.Progress, gg.MaxValue]);
if gg.Progress = gg.MaxValue then
begin
Close;
end;
Application.ProcessMessages;
end;
end.
{下面为uProgressBar.dfm的代码}
object frmProgressBar: TfrmProgressBar
Left = 0
Top = 0
BorderStyle = bsNone
Caption = 'frmProgressBar'
ClientHeight = 90
ClientWidth = 425
Color = clCream
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
FormStyle = fsStayOnTop
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 13
object gg: TGauge
Left = 8
Top = 45
Width = 409
Height = 11
BackColor = 14867189
ForeColor = 13996640
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
Progress = 0
end
object lblCap: TLabel
Left = 8
Top = 16
Width = 285
Height = 18
Caption = #25968#25454#27491#22312#22788#29702#20013#65292#35831#24744#32784#24515#31561#24453#65294#65294#65294#65294#65294
Font.Charset = DEFAULT_CHARSET
Font.Color = 12615680
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
object lblInf: TLabel
Left = 8
Top = 64
Width = 60
Height = 14
Caption = #65294#65294#65294#65294#65294
Font.Charset = DEFAULT_CHARSET
Font.Color = 12615808
Font.Height = -12
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
end
