В приведенном ниже коде используется поток для имитации длительного выполнения блока в методе 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 для этого объекта:
- To avoid the access to the VCL data from the thread - it's the preferred way if the already modified data have to be reused in the routine:
- pass a copy of the grid's data to the thread - say in the constructor
- обновить копию
- обновить сетку отредактированной копией данных после завершения потока, т.е. после возврата
ShowModal
.
- To access the form's object from the thread - this can be done if the form's objects are accessed for very short time intervals:
- use a synchronized block to get the data from the grid
- обновить сетку в синхронизированном обратном вызове потока, т.е. в методе
myRunProgress
или в методе myRunTerminate
Для разных случаев использования также может иметь смысл смешанный подход (передача копии в конструкторе/обновление сетки в синхронизированном блоке потока), если ваша подпрограмма не учитывает уже измененные данные: выберите метод, который лучше всего соответствует вашим потребностям.
Если другой внешний поток обновляет сетку, thread1
может прочитать данные, а затем заполнить частную очередь формы — скажем, TThreadList
или другую коллекцию в блоке TCriticalSection
— и уведомить thread2
о выполнении задания в очереди, но я надеюсь, что это, вероятно, не так. необходимо, чтобы ваша работа была сделана.
person
fantaghirocco came to Rome
schedule
24.02.2016
ProcessMessages
во время цикла. 3) Переместите работу в фоновый поток и используйте обратные вызовы. Метод 3 является идеальным, как правило. Если ваш блокирующий вызов не содержит цикла (или не находится под вашим контролем), у вас действительно есть только один вариант — № 3, использовать поток. - person J...   schedule 22.02.2016