Execute
下面的代码使用一个线程在其方法中模拟长时间运行的块,并使用OnProgress
“回调”来通知表单完成百分比已更改。
这是一个非常简单的例子,但在我看来,它可以向您展示正确的方向之一。
请注意,当前没有执行错误检查或异常处理。
Unit1.pas
主窗体和线程类
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls, Unit2;
type
TMyRun = class(TThread)
protected
procedure Execute; override;
public
OnProgress: TProgressEvent;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FProgressForm: TfrmProgress;
procedure myRunProgress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
procedure myRunTerminate(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TMyRun.Execute;
var
i: Integer;
r: TRect;
begin
for i := 1 to 100 do begin
if Terminated then
Break;
Sleep(50);//simulates some kind of operation
if Assigned(OnProgress) then
Synchronize(procedure
begin
OnProgress(Self, psRunning, i, False, r, '');
end);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FProgressForm := TfrmProgress.Create(nil);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FProgressForm.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
with TMyRun.Create do begin
FreeOnTerminate := True;
OnProgress := myRunProgress;
OnTerminate := myRunTerminate;
end;
FProgressForm.ShowModal;
end;
procedure TForm1.myRunProgress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
FProgressForm.ProgressBar1.Position := PercentDone;
end;
procedure TForm1.myRunTerminate(Sender: TObject);
begin
FProgressForm.Close;
end;
end.
Unit1.dfm
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 81
ClientWidth = 181
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 48
Top = 24
Width = 91
Height = 25
Caption = 'Run the thread'
TabOrder = 0
OnClick = Button1Click
end
end
Unit2.pas
进度对话框
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls;
type
TfrmProgress = class(TForm)
ProgressBar1: TProgressBar;
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmProgress: TfrmProgress;
implementation
{$R *.dfm}
end.
Unit2.dfm
object frmProgress: TfrmProgress
Left = 0
Top = 0
BorderStyle = bsSizeToolWin
Caption = 'frmProgress'
ClientHeight = 51
ClientWidth = 294
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object ProgressBar1: TProgressBar
Left = 16
Top = 16
Width = 265
Height = 17
TabOrder = 0
end
end
参考评论指出长时间运行的操作需要访问主窗体中的网格,以避免阻塞该对象上的 VCL 线程:
- 为了避免从线程访问 VCL 数据 -如果必须在例程中重用已修改的数据,这是首选方式:
- 将网格数据的副本传递给线程——比如在构造函数中
- 更新副本
- 在线程完成后使用编辑后的数据副本更新网格 - 即在
ShowModal
返回之后。
- 要从线程访问表单的对象 -如果在很短的时间间隔内访问表单的对象,则可以这样做:
- 使用同步块从网格中获取数据
- 在线程的同步回调中更新网格 - 即在方法中
myRunProgress
或myRunTerminate
方法中
对于不同的用例,如果您的例程不考虑已更改的数据,则混合方法也可能有意义(在构造函数中传递副本/更新线程同步块中的网格):选择最适合您需要的方法.
如果另一个外部线程更新了网格,athread1
可以读取数据然后填充表单的私有队列——比如块TThreadList
中的一个或另一个集合TCriticalSection
——并通知 athread2
在队列上执行一项工作,但我希望这可能不需要让你的任务完成。