delphi - google tag manager

¿Necesito TThreads? Si es así, ¿puedo pausar, reanudar y detenerlos?

Question

Siempre me he preguntado si existe alguna forma mejor de escribir algunos de mis procedimientos, en particular los que tardan mucho en terminar.

Siempre he ejecutado todo fuera del subproceso de GUI principal, que ahora entiendo y me doy cuenta es malo porque hará que la aplicación no responda, Application.ProcessMessages no ayudará realmente aquí.

Esto me hace pensar que necesito usar TThreads para operaciones largas como copiar un archivo, por ejemplo. Esto también me hizo preguntarme cómo algunas aplicaciones le dan control total, por ejemplo, le permiten pausar, reanudar y detener la operación.

Tengo alrededor de 3 operaciones largas en un proyecto personal en el que estoy trabajando y en las que aparece un formulario de diálogo con TProgressBar activado. Mientras esto funciona, creo que se podría hacer mucho mejor. Estos cuadros de diálogo de progreso se pueden mostrar durante tanto tiempo que es posible que desee cancelar la operación y, en su lugar, finalizar el trabajo más tarde.

Como dije, actualmente estoy ejecutando el hilo principal de Gui, ¿necesito usar TThreads? No estoy seguro de cómo o dónde comenzar a implementarlos ya que no he trabajado con ellos antes. Si necesito hilos, ¿ofrecen lo que necesito, como pausar, reanudar, detener una operación, etc.?

Básicamente, estoy buscando una mejor forma de manejar y administrar operaciones largas.

Answer 1

Sí, este es definitivamente un caso en el que necesita un hilo para hacer la tarea.

Un pequeño ejemplo de cómo pausar / reanudar un hilo y cancelar el hilo.

El progreso se envía al hilo principal a través de una llamada de PostMessage. La pausa / reanudar y cancelar se realizan con TSimpleEvent señales TSimpleEvent .

Editar: Según los comentarios de @mghie, aquí hay un ejemplo más completo:

Editar 2: muestra cómo pasar un procedimiento para que el hilo llame para el trabajo pesado.

Edición 3: Se agregaron algunas características más y una unidad de prueba.

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.

Simplemente llame a MyThread.Paused := true a pause y MyThread.Paused := false para reanudar la operación de subprocesos.

Para cancelar el hilo, llame a MyThread.Free .

Para recibir los mensajes publicados desde el hilo, consulte el siguiente ejemplo:

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.

Y la forma:

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

Answer 2

Si el código de muestra en la respuesta de LU RD es demasiado complicado para su gusto, entonces tal vez una implementación Delphi de la clase .net BackgroundWorker sea ​​más de su agrado.

Al usar esto, puede colocar un componente en su formulario y agregar controladores para sus diversos eventos ( OnWork , OnWorkProgress , OnWorkFeedback y OnWorkComplete ). El componente ejecutará el controlador de eventos OnWork en segundo plano, mientras ejecuta los otros manejadores de eventos desde el hilo de la GUI (teniendo en cuenta los cambios de contexto necesarios y la sincronización). Sin embargo, una comprensión profunda de lo que puede y lo que no debe hacer desde subprocesos secundarios sigue siendo necesaria para escribir código en el controlador de eventos OnWork .

Answer 3

También puede usar bibliotecas de nivel superior para enhebrar, como:

• http://andy.jgknet.de/blog/bugfix-units/asynccalls-29-asynchronous-function-calls/
• http://otl.17slon.com/

Answer 4

Una introducción útil al multihilo fue escrita por un tipo llamado Martin Harvey, hace muchos años. Su tutorial se puede encontrar en el sitio de Embarcadero CC , también parece que ha subido una clase de ejemplo que hace el tipo de cosas que está buscando, pero no lo he visto, así que no puedo asegurarlo.