能不能用线程建立一个form,上面有进度条,在按照一定的速度移动。平时这个线程挂起,当运行其他form查询的时候,这个线程开始运行,并显示。运行完查询的时候,这个线程挂起并隐藏到后台,这种功能能否实现?代码应该如何写?
看了许多类似的问题,但都是一两句话带过,或者用Ani来代替,我用线程来实现的时候,发现显示出来的窗口根本不会动,请有代码的帮下实现。
9 个解决方案
#1
需要sychronize()同步可视控件吧
#2
type
TMyThread = class(TThread)
private
{ Private declarations }
FProgressBar: TProgressBar; //ProgressBar 对象
fProgress: Integer; //ProgressBar 进度值
protected
procedure Execute; override;
procedure UpDateProgress; //向主窗体更新进度的方法
public
constructor Create(CreateSuspended: Boolean; ProgressBar: TProgressBar);
end;
implementation
constructor TMyThread.Create(CreateSuspended: Boolean;
ProgressBar: TProgressBar);
begin
inherited Create(CreateSuspended);
FProgressBar := ProgressBar;
end;
procedure TMyThread.Execute;
var
i: integer;
begin
fProgress := 0;
for i := 1 to 100 do
begin
fProgress := i;
Synchronize(UpDateProgress); //同步更新主窗体中的ProgressBar
Sleep(150);
end;
end;
procedure TMyThread.UpDateProgress;
begin
FProgressBar.Position := fProgress;
end;
///////////
使用方法
var
MyThread: TMyThread;
begin
MyThread := TMyThread.create(ture,From1.ProgressBar1);
MyThread.Resume;
end;
TMyThread = class(TThread)
private
{ Private declarations }
FProgressBar: TProgressBar; //ProgressBar 对象
fProgress: Integer; //ProgressBar 进度值
protected
procedure Execute; override;
procedure UpDateProgress; //向主窗体更新进度的方法
public
constructor Create(CreateSuspended: Boolean; ProgressBar: TProgressBar);
end;
implementation
constructor TMyThread.Create(CreateSuspended: Boolean;
ProgressBar: TProgressBar);
begin
inherited Create(CreateSuspended);
FProgressBar := ProgressBar;
end;
procedure TMyThread.Execute;
var
i: integer;
begin
fProgress := 0;
for i := 1 to 100 do
begin
fProgress := i;
Synchronize(UpDateProgress); //同步更新主窗体中的ProgressBar
Sleep(150);
end;
end;
procedure TMyThread.UpDateProgress;
begin
FProgressBar.Position := fProgress;
end;
///////////
使用方法
var
MyThread: TMyThread;
begin
MyThread := TMyThread.create(ture,From1.ProgressBar1);
MyThread.Resume;
end;
#3
我最近也搞了等待窗口的问题,最后的结论是无论使用怎样的线程,我们的主线程是不能执行代码,应该说主线程不能执行长时间的代码,否则等待窗口的线程会等待主线程执行完了再执行,可能是主线程和子线程的优先级的问题
#4
把查询之类的阻塞操作放到线程中做,主线程做显示,
检测到子线程执行完了,主线程停止相关显示
检测到子线程执行完了,主线程停止相关显示
#5
在楼主对WINDOWS编程与线程把握得相当功底之前,
先把这当成一个戒条来遵守吧:不要在非主线程创建WINDOW.
这意思在MSDN上面也提到过.
先把这当成一个戒条来遵守吧:不要在非主线程创建WINDOW.
这意思在MSDN上面也提到过.
#6
发送消息给进度显示窗体。
#7
我分2个问题解答,看看行不行;
1 在线程中创建窗体
{ Tmythread }
procedure Tmythread.Execute;
begin
Synchronize(self.formcreate);
end;
procedure Tmythread.formcreate;
var
f:Tform2;
begin
try
f:=tform2.Create(form2);
f.Show;
except
f.Free;
end;
end;
{总结,在线程中使用vcl需要使用同步函数Synchronize}
2 传递进度消息
procedure getmessage(var msg:Tmessage);message myprocessmessage;
{ Public declarations }
end;
procedure Tprocessfm.getmessage(var msg: Tmessage);
begin
if msg.WParam>0 then
begin
self.ProgressBar1.Position:=msg.WParam;
end;
if msg.LParam=1 then
begin
self.ProgressBar1.Position:=self.ProgressBar1.Max;
sleep(500);
self.Close;
end;
end;
{使用消息来控制这个form,如果lparam=1 就自动关闭}
看看行不
1 在线程中创建窗体
{ Tmythread }
procedure Tmythread.Execute;
begin
Synchronize(self.formcreate);
end;
procedure Tmythread.formcreate;
var
f:Tform2;
begin
try
f:=tform2.Create(form2);
f.Show;
except
f.Free;
end;
end;
{总结,在线程中使用vcl需要使用同步函数Synchronize}
2 传递进度消息
procedure getmessage(var msg:Tmessage);message myprocessmessage;
{ Public declarations }
end;
procedure Tprocessfm.getmessage(var msg: Tmessage);
begin
if msg.WParam>0 then
begin
self.ProgressBar1.Position:=msg.WParam;
end;
if msg.LParam=1 then
begin
self.ProgressBar1.Position:=self.ProgressBar1.Max;
sleep(500);
self.Close;
end;
end;
{使用消息来控制这个form,如果lparam=1 就自动关闭}
看看行不
#8
用发送消息方式吧,这个比较好:
thread1.execute
begin
//do your thread things.
postMessage(fm_query.handle,MSG_QUERY_PROGRESS_ADD1,0,进度数);
end;
然后在 fm_query中做一个自定义消息
如 procedure progressAdd1(var Msg: TMessage); message MSG_QUERY_PROGRESS_ADD1;
procedure fm_query.progressAdd1(var Msg: TMessage);
begin
//进度加1代码
end;
thread1.execute
begin
//do your thread things.
postMessage(fm_query.handle,MSG_QUERY_PROGRESS_ADD1,0,进度数);
end;
然后在 fm_query中做一个自定义消息
如 procedure progressAdd1(var Msg: TMessage); message MSG_QUERY_PROGRESS_ADD1;
procedure fm_query.progressAdd1(var Msg: TMessage);
begin
//进度加1代码
end;
#9
用线程貌似有点麻烦.可以考虑用下面这个作法..
//-------------显示的滚动条窗体-----------------------
//-----------------------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.
//-----------------------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
//控制显示滚动条窗体的unit
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.
//-----------------------------------
调用的时候按照下面的方式来调用.
CreateProgressDlg();
try
while () do begin
UpdateProgressDlg();
end;
finally
DestroyProgressDlg();
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.
//-----------------------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
//控制显示滚动条窗体的unit
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.
//-----------------------------------
调用的时候按照下面的方式来调用.
CreateProgressDlg();
try
while () do begin
UpdateProgressDlg();
end;
finally
DestroyProgressDlg();
end;
#1
需要sychronize()同步可视控件吧
#2
type
TMyThread = class(TThread)
private
{ Private declarations }
FProgressBar: TProgressBar; //ProgressBar 对象
fProgress: Integer; //ProgressBar 进度值
protected
procedure Execute; override;
procedure UpDateProgress; //向主窗体更新进度的方法
public
constructor Create(CreateSuspended: Boolean; ProgressBar: TProgressBar);
end;
implementation
constructor TMyThread.Create(CreateSuspended: Boolean;
ProgressBar: TProgressBar);
begin
inherited Create(CreateSuspended);
FProgressBar := ProgressBar;
end;
procedure TMyThread.Execute;
var
i: integer;
begin
fProgress := 0;
for i := 1 to 100 do
begin
fProgress := i;
Synchronize(UpDateProgress); //同步更新主窗体中的ProgressBar
Sleep(150);
end;
end;
procedure TMyThread.UpDateProgress;
begin
FProgressBar.Position := fProgress;
end;
///////////
使用方法
var
MyThread: TMyThread;
begin
MyThread := TMyThread.create(ture,From1.ProgressBar1);
MyThread.Resume;
end;
TMyThread = class(TThread)
private
{ Private declarations }
FProgressBar: TProgressBar; //ProgressBar 对象
fProgress: Integer; //ProgressBar 进度值
protected
procedure Execute; override;
procedure UpDateProgress; //向主窗体更新进度的方法
public
constructor Create(CreateSuspended: Boolean; ProgressBar: TProgressBar);
end;
implementation
constructor TMyThread.Create(CreateSuspended: Boolean;
ProgressBar: TProgressBar);
begin
inherited Create(CreateSuspended);
FProgressBar := ProgressBar;
end;
procedure TMyThread.Execute;
var
i: integer;
begin
fProgress := 0;
for i := 1 to 100 do
begin
fProgress := i;
Synchronize(UpDateProgress); //同步更新主窗体中的ProgressBar
Sleep(150);
end;
end;
procedure TMyThread.UpDateProgress;
begin
FProgressBar.Position := fProgress;
end;
///////////
使用方法
var
MyThread: TMyThread;
begin
MyThread := TMyThread.create(ture,From1.ProgressBar1);
MyThread.Resume;
end;
#3
我最近也搞了等待窗口的问题,最后的结论是无论使用怎样的线程,我们的主线程是不能执行代码,应该说主线程不能执行长时间的代码,否则等待窗口的线程会等待主线程执行完了再执行,可能是主线程和子线程的优先级的问题
#4
把查询之类的阻塞操作放到线程中做,主线程做显示,
检测到子线程执行完了,主线程停止相关显示
检测到子线程执行完了,主线程停止相关显示
#5
在楼主对WINDOWS编程与线程把握得相当功底之前,
先把这当成一个戒条来遵守吧:不要在非主线程创建WINDOW.
这意思在MSDN上面也提到过.
先把这当成一个戒条来遵守吧:不要在非主线程创建WINDOW.
这意思在MSDN上面也提到过.
#6
发送消息给进度显示窗体。
#7
我分2个问题解答,看看行不行;
1 在线程中创建窗体
{ Tmythread }
procedure Tmythread.Execute;
begin
Synchronize(self.formcreate);
end;
procedure Tmythread.formcreate;
var
f:Tform2;
begin
try
f:=tform2.Create(form2);
f.Show;
except
f.Free;
end;
end;
{总结,在线程中使用vcl需要使用同步函数Synchronize}
2 传递进度消息
procedure getmessage(var msg:Tmessage);message myprocessmessage;
{ Public declarations }
end;
procedure Tprocessfm.getmessage(var msg: Tmessage);
begin
if msg.WParam>0 then
begin
self.ProgressBar1.Position:=msg.WParam;
end;
if msg.LParam=1 then
begin
self.ProgressBar1.Position:=self.ProgressBar1.Max;
sleep(500);
self.Close;
end;
end;
{使用消息来控制这个form,如果lparam=1 就自动关闭}
看看行不
1 在线程中创建窗体
{ Tmythread }
procedure Tmythread.Execute;
begin
Synchronize(self.formcreate);
end;
procedure Tmythread.formcreate;
var
f:Tform2;
begin
try
f:=tform2.Create(form2);
f.Show;
except
f.Free;
end;
end;
{总结,在线程中使用vcl需要使用同步函数Synchronize}
2 传递进度消息
procedure getmessage(var msg:Tmessage);message myprocessmessage;
{ Public declarations }
end;
procedure Tprocessfm.getmessage(var msg: Tmessage);
begin
if msg.WParam>0 then
begin
self.ProgressBar1.Position:=msg.WParam;
end;
if msg.LParam=1 then
begin
self.ProgressBar1.Position:=self.ProgressBar1.Max;
sleep(500);
self.Close;
end;
end;
{使用消息来控制这个form,如果lparam=1 就自动关闭}
看看行不
#8
用发送消息方式吧,这个比较好:
thread1.execute
begin
//do your thread things.
postMessage(fm_query.handle,MSG_QUERY_PROGRESS_ADD1,0,进度数);
end;
然后在 fm_query中做一个自定义消息
如 procedure progressAdd1(var Msg: TMessage); message MSG_QUERY_PROGRESS_ADD1;
procedure fm_query.progressAdd1(var Msg: TMessage);
begin
//进度加1代码
end;
thread1.execute
begin
//do your thread things.
postMessage(fm_query.handle,MSG_QUERY_PROGRESS_ADD1,0,进度数);
end;
然后在 fm_query中做一个自定义消息
如 procedure progressAdd1(var Msg: TMessage); message MSG_QUERY_PROGRESS_ADD1;
procedure fm_query.progressAdd1(var Msg: TMessage);
begin
//进度加1代码
end;
#9
用线程貌似有点麻烦.可以考虑用下面这个作法..
//-------------显示的滚动条窗体-----------------------
//-----------------------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.
//-----------------------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
//控制显示滚动条窗体的unit
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.
//-----------------------------------
调用的时候按照下面的方式来调用.
CreateProgressDlg();
try
while () do begin
UpdateProgressDlg();
end;
finally
DestroyProgressDlg();
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.
//-----------------------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
//控制显示滚动条窗体的unit
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.
//-----------------------------------
调用的时候按照下面的方式来调用.
CreateProgressDlg();
try
while () do begin
UpdateProgressDlg();
end;
finally
DestroyProgressDlg();
end;