即插即用的绿色代码 通用单进度条构件单元

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


阅读更多
个人分类: 技术
想对作者说点什么? 我来说一句

没有更多推荐了,返回首页

加入CSDN,享受更精准的内容推荐,与500万程序员共同成长!
关闭
关闭