Подтвердить что ты не робот

Нужны ли мне TThreads? Если это так, я могу приостановить, возобновить и остановить их?

Я всегда задавался вопросом, есть ли лучший способ написать некоторые из моих процедур, особенно те, которые занимают много времени.

Я всегда запускаю все, что связано с Главным графическим потоком, который я теперь понимаю и понимаю плохо, потому что это сделает приложение невосприимчивым, Application.ProcessMessages здесь действительно не поможет.

Это заставляет меня думать, что мне нужно использовать TThreads для длительных операций, например, для копирования файла. Это также заставило меня задуматься, как некоторые приложения дают вам полный контроль, например, позволяют приостановить, возобновить и/или остановить операцию.

У меня около 3 длительных операций в личном проекте, над которым я работаю, на котором я показываю диалоговую форму с TProgressBar. Пока это работает, я чувствую, что это можно сделать гораздо лучше. Эти диалоги прогресса могут отображаться в течение столь длительного времени, что вы можете отказаться от операции и вместо этого завершить работу позже.

Как я уже сказал, в настоящее время я запускаю Thread Main Gui, вместо этого мне нужно использовать TThreads? Я не уверен, как и где начать внедрять их, поскольку я раньше не работал с ними. Если мне нужны потоки, они предлагают то, что мне нужно, например, приостановка, возобновление, остановка операции и т.д.

В основном я ищу лучший способ обработки и управления длительными операциями.

4b9b3361

ОТВЕТЫ

Ответ 1

Да, это определенно случай, когда вам нужен поток для выполнения задачи.

Небольшой пример того, как приостановить/возобновить поток и отменить поток.

Прогресс отправляется в основной поток через вызов PostMessage. Пауза/возобновление и отмена выполняются с помощью сигналов TSimpleEvent.

Изменить: В соответствии с комментариями @mghie, вот более полный пример:

Изменить 2: Показывать, как передать процедуру для потока, чтобы вызвать тяжелую работу.

Изменить 3: Добавлено несколько функций и тестовый блок.

unit WorkerThread;

interface

uses Windows, Classes, SyncObjs;

type
  TWorkFunction = function: boolean of object;

  TWorkerThread = Class(TThread)
  private
    FCancelFlag: TSimpleEvent;
    FDoWorkFlag: TSimpleEvent;
    FOwnerFormHandle: HWND;
    FWorkFunc: TWorkFunction; // Function method to call
    FCallbackMsg: integer; // PostMessage id
    FProgress: integer;
    procedure SetPaused(doPause: boolean);
    function GetPaused: boolean;
    procedure Execute; override;
  public
    Constructor Create(WindowHandle: HWND; callbackMsg: integer;
      myWorkFunc: TWorkFunction);
    Destructor Destroy; override;
    function StartNewWork(newWorkFunc: TWorkFunction): boolean;
    property Paused: boolean read GetPaused write SetPaused;
  end;

implementation

constructor TWorkerThread.Create(WindowHandle: HWND; callbackMsg: integer;
  myWorkFunc: TWorkFunction);
begin
  inherited Create(false);
  FOwnerFormHandle := WindowHandle;
  FDoWorkFlag := TSimpleEvent.Create;
  FCancelFlag := TSimpleEvent.Create;
  FWorkFunc := myWorkFunc;
  FCallbackMsg := callbackMsg;
  Self.FreeOnTerminate := false; // Main thread controls for thread destruction
  if Assigned(FWorkFunc) then
    FDoWorkFlag.SetEvent; // Activate work at start
end;

destructor TWorkerThread.Destroy; // Call MyWorkerThread.Free to cancel the thread
begin
  FDoWorkFlag.ResetEvent; // Stop ongoing work
  FCancelFlag.SetEvent; // Set cancel flag
  Waitfor; // Synchronize
  FCancelFlag.Free;
  FDoWorkFlag.Free;
  inherited;
end;

procedure TWorkerThread.SetPaused(doPause: boolean);
begin
  if doPause then
    FDoWorkFlag.ResetEvent
  else
    FDoWorkFlag.SetEvent;
end;

function TWorkerThread.StartNewWork(newWorkFunc: TWorkFunction): boolean;
begin
  Result := Self.Paused; // Must be paused !
  if Result then
  begin
    FWorkFunc := newWorkFunc;
    FProgress := 0; // Reset progress counter
    if Assigned(FWorkFunc) then
      FDoWorkFlag.SetEvent; // Start work
  end;
end;

procedure TWorkerThread.Execute;
{- PostMessage LParam:
  0 : Work in progress, progress counter in WParam
  1 : Work is ready
  2 : Thread is closing
}
var
  readyFlag: boolean;
  waitList: array [0 .. 1] of THandle;
begin
  FProgress := 0;
  waitList[0] := FDoWorkFlag.Handle;
  waitList[1] := FCancelFlag.Handle;
  while not Terminated do
  begin
    if (WaitForMultipleObjects(2, @waitList[0], false, INFINITE) <>
      WAIT_OBJECT_0) then
      break; // Terminate thread when FCancelFlag is signaled
    // Do some work
    readyFlag := FWorkFunc;
    if readyFlag then // work is done, pause thread
      Self.Paused := true;
    Inc(FProgress);
    // Inform main thread about progress
    PostMessage(FOwnerFormHandle, FCallbackMsg, WPARAM(FProgress),
      LPARAM(readyFlag));
  end;
  PostMessage(FOwnerFormHandle, FCallbackMsg, 0, LPARAM(2)); // Closing thread
end;

function TWorkerThread.GetPaused: boolean;
begin
  Result := (FDoWorkFlag.Waitfor(0) <> wrSignaled);
end;

end.

Просто вызовите MyThread.Paused := true для паузы и MyThread.Paused := false, чтобы возобновить операцию потока.

Чтобы отменить поток, вызовите MyThread.Free.

Чтобы получить отправленные сообщения из потока, см. следующий пример:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, WorkerThread;

const
  WM_MyProgress = WM_USER + 0; // The unique message id

type
  TForm1 = class(TForm)
    Label1: TLabel;
    btnStartTask: TButton;
    btnPauseResume: TButton;
    btnCancelTask: TButton;
    Label2: TLabel;
    procedure btnStartTaskClick(Sender: TObject);
    procedure btnPauseResumeClick(Sender: TObject);
    procedure btnCancelTaskClick(Sender: TObject);
  private
    { Private declarations }
    MyThread: TWorkerThread;
    workLoopIx: integer;

    function HeavyWork: boolean;
    procedure OnMyProgressMsg(var Msg: TMessage); message WM_MyProgress;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }
const
  cWorkLoopMax = 500;

function TForm1.HeavyWork: boolean; // True when ready
var
  i, j: integer;
begin
  j := 0;
  for i := 0 to 10000000 do
    Inc(j);
  Inc(workLoopIx);
  Result := (workLoopIx >= cWorkLoopMax);
end;

procedure TForm1.btnStartTaskClick(Sender: TObject);
begin
  if not Assigned(MyThread) then
  begin
    workLoopIx := 0;
    btnStartTask.Enabled := false;
    btnPauseResume.Enabled := true;
    btnCancelTask.Enabled := true;
    MyThread := TWorkerThread.Create(Self.Handle, WM_MyProgress, HeavyWork);
  end;
end;

procedure TForm1.btnPauseResumeClick(Sender: TObject);
begin
  if Assigned(MyThread) then
    MyThread.Paused := not MyThread.Paused;
end;

procedure TForm1.btnCancelTaskClick(Sender: TObject);
begin
  if Assigned(MyThread) then
  begin
    FreeAndNil(MyThread);
    btnStartTask.Enabled := true;
    btnPauseResume.Enabled := false;
    btnCancelTask.Enabled := false;
  end;
end;

procedure TForm1.OnMyProgressMsg(var Msg: TMessage);
begin
  Msg.Msg := 1;
  case Msg.LParam of
    0:
      Label1.Caption := Format('%5.1f %%', [100.0 * Msg.WParam / cWorkLoopMax]);
    1:
      begin
        Label1.Caption := 'Task done';
        btnCancelTaskClick(Self);
      end;
    2:
      Label1.Caption := 'Task terminated';
  end;
end;

end.

И форма:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 163
  ClientWidth = 328
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 120
  TextHeight = 16
  object Label1: TLabel
    Left = 79
    Top = 18
    Width = 51
    Height = 16
    Caption = 'Task idle'
  end
  object Label2: TLabel
    Left = 32
    Top = 18
    Width = 41
    Height = 16
    Caption = 'Status:'
  end
  object btnStartTask: TButton
    Left = 32
    Top = 40
    Width = 137
    Height = 25
    Caption = 'Start'
    TabOrder = 0
    OnClick = btnStartTaskClick
  end
  object btnPauseResume: TButton
    Left = 32
    Top = 71
    Width = 137
    Height = 25
    Caption = 'Pause/Resume'
    Enabled = False
    TabOrder = 1
    OnClick = btnPauseResumeClick
  end
  object btnCancelTask: TButton
    Left = 32
    Top = 102
    Width = 137
    Height = 25
    Caption = 'Cancel'
    Enabled = False
    TabOrder = 2
    OnClick = btnCancelTaskClick
  end
end

Ответ 3

Если образец кода в ответе LU RD слишком сложный для вашего вкуса, то, возможно, реализация Delphi класса .net BackgroundWorker больше по душе.

Используя это, вы можете отбросить компонент на свою форму и добавить обработчики для различных событий (OnWork, OnWorkProgress, OnWorkFeedback и OnWorkComplete). Компонент выполнит обработчик события OnWork в фоновом режиме, выполняя другие обработчики событий из потока графического интерфейса (заботясь о необходимых переключателях контекста и синхронизации). Тем не менее, полное понимание того, что вы можете и что вы не должны делать из вторичных потоков, по-прежнему необходимо для написания кода в обработчике событий OnWork.

Ответ 4

Полезное введение в многопоточность было написано парнем по имени Мартин Харви, много лет назад. Его учебник можно найти на веб-сайте Embarcadero CC - похоже, он загрузил примерный класс, который делает то, что вы ищете, но я не смотрел на него, поэтому не могу сказать точно.