进度条窗体的源代码 - Delphi

1个窗体,1个unit

先说调用方法吧,刚才在csdn里也贴了这段代码..不过没写详细使用方法...汗..

  CreateProgressDlg();
  try
    while () do begin
      UpdateProgressDlg();

       if  ProgressCanceled then

        break;
    end;
  finally
    DestroyProgressDlg();
  end;

//--------------------------------------------进度条窗体-------------------------------------

//------------------------------DFM文件---------------------------------

object Form_Process: TForm_Process
  Left = 210
  Top = 192
  BorderIcons = [biSystemMenu]
  BorderStyle = bsDialog
  ClientHeight = 87
  ClientWidth = 442
  Color = clBtnFace
  Font.Charset = GB2312_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = '宋体'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = True
  Position = poScreenCenter
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 12
  object Bevel: TBevel
    Left = 0
    Top = 0
    Width = 442
    Height = 87
    Shape = bsFrame
    Style = bsRaised
  end
  object lblStatus: TLabel
    Left = 8
    Top = 56
    Width = 339
    Height = 13
    AutoSize = False
  end
  object ProgressBar: TProgressBar
    Left = 10
    Top = 70
    Width = 337
    Height = 10
    Min = 0
    Max = 100
    Position = 34
    TabOrder = 0
  end
  object btnCancel: TButton
    Left = 355
    Top = 55
    Width = 75
    Height = 25
    Cursor = crArrow
    Cancel = True
    Caption = '&Cancel'
    ModalResult = 2
    TabOrder = 1
    OnClick = btnCancelClick
  end
end

//---------------------------------------------PAS文件-------------------------------

unit UForm_Process;

interface

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

type
  TForm_Process = class(TForm)
    ProgressBar: TProgressBar;
    btnCancel: TButton;
    Bevel: TBevel;
    lblStatus: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    Animate: TAnimate;
    CancelPressed: Boolean;
  end;

implementation

{$R *.DFM}

procedure TForm_Process.FormCreate(Sender: TObject);
begin
  Animate := TAnimate.Create(Self);
  with Animate do
  begin
    Left := 8;
    Top := 4;
    Width := 427;
    Height := 45;
    Parent := Self;
    Active := False;
    AutoSize := False;
    CommonAVI := aviCopyFile;
    StopFrame := 34;
    ParentColor := True;
    Transparent := True;
  end;
  CancelPressed := False;
  DoubleBuffered := True;
end;

procedure TForm_Process.btnCancelClick(Sender: TObject);
begin
  CancelPressed := True;
end;

procedure TForm_Process.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  CancelPressed := True;
end;

end.

 

//-----------------------------------------进度条控制单元------------------------------

unit UControl_Process;

interface
uses
  UForm_Process, Forms, SysUtils;

function CreateProgressDlg(strCaption, strMessage, strBtnCaption: string; MinValue, MaxValue, Progress: Longint): Boolean;
function DestroyProgressDlg: Boolean;
function UpdateProgressDlg(strMessage: string; Progress: Longint): Boolean;
function ProgressCanceled: Boolean;

implementation

var
  Form_Process: TForm_Process;

function CreateProgressDlg(strCaption, strMessage, strBtnCaption: string; MinValue, MaxValue, Progress: Longint): Boolean;
begin
  Result := False;

  try
    DestroyProgressDlg;
    Form_Process := TForm_Process.Create(Application);
    Application.ProcessMessages;
    with Form_Process do
    begin
      Caption := strCaption;
      lblStatus.Caption := strMessage;
      btnCancel.Caption := strBtnCaption;
      ProgressBar.Min := MinValue;
      ProgressBar.Max := MaxValue;
      ProgressBar.Position := Progress;
      ProgressBar.Visible := not ((MinValue = 0) and (MaxValue = 0));
      Animate.Active := True;
      Show;
      Application.ProcessMessages;
    end;
    Result := True;
  except
    try
      Form_Process.Free;
    finally
      Form_Process := nil;
    end;
  end;
end;

function DestroyProgressDlg: Boolean;
begin
  Result := False;

  if Assigned(Form_Process) then
    try
      Form_Process.Animate.Active := False;
      Form_Process.Free;
      Form_Process := nil;
      Application.ProcessMessages;
      Result := True;
    except
    end;
end;

function UpdateProgressDlg(strMessage: string; Progress: Longint): Boolean;
begin
  Result := False;

  if Assigned(Form_Process) then
    with Form_Process do
    begin
      lblStatus.Caption := strMessage + ' (' + IntToStr(Progress) + '/' + IntToStr(ProgressBar.Max) + ')';
      ProgressBar.Position := Progress;
      Update;

      Application.ProcessMessages;

      Result := True;
    end;
end;

function ProgressCanceled: Boolean;
begin
  Result := False;
  if Assigned(Form_Process) then
    Result := Form_Process.CancelPressed;
end;

end.