Czy potrzebuję TThreads? Jeśli tak, mogę zatrzymać, wznowić i zatrzymać?

Question

Zawsze zastanawiałem się, czy istnieje lepszy sposób, w jaki powinienem napisać niektóre z moich procedur, szczególnie tych, które wymagają długiego czasu.

Zawsze uruchamiałam wszystko poza głównym GUI Wątek, który teraz rozumiem i rozumiem jest zły, ponieważ spowoduje, że aplikacja przestanie reagować, Application.ProcessMessages nie pomoże tutaj.

To powoduje, że muszę używać TThreads do długich operacji, takich jak na przykład kopiowanie pliku. Zastanawiam się również, w jaki sposób niektóre aplikacje dają pełną kontrolę, np. Pozwalają wstrzymać, wznowić lub zatrzymać operację.

Mam około 3 długich operacji w projekcie osobistym, nad którym pracuję, na którym wyświetlam formularz dialogowy z TProgressBar na. Chociaż to działa, wydaje mi się, że można to zrobić znacznie lepiej. Te okna dialogowe postępu mogą być wyświetlane przez tak długi czas, że możesz anulować operację i zamiast tego zakończyć pracę później.

Jak już powiedziałem, obecnie używam wątku Main Gui, czy zamiast tego muszę używać TThreads? Nie wiem, jak i gdzie zacząć je wdrażać, ponieważ nie pracowałem z nimi wcześniej. Jeśli potrzebuję wątków, czy oferują one to, czego potrzebuję, takie jak wstrzymywanie, wznawianie, zatrzymywanie operacji itp.?

Zasadniczo szukam lepszego sposobu obsługi i zarządzania długimi operacjami.

Answer 1

Tak, jest to zdecydowanie przypadek, w którym do wykonania zadania potrzebny jest wątek.

Mały przykład zatrzymania/wznowienia wątku i anulowania wątku.

Postęp jest wysyłany do głównego wątku za pomocą wywołania PostMessage. Przerwa/wznowienie i anulowanie są wykonywane z sygnałami TSimpleEvent.

Edit: Zgodnie z @mghie komentarzach, tutaj jest bardziej kompletny przykład:

Edit 2: Pokazuje jak przejść procedurę wątek zadzwonić do ciężkiej pracy.

Edytuj 3: Dodano kilka dodatkowych funkcji i jednostkę testową.

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. 

Wystarczy zadzwonić MyThread.Paused := true aby wstrzymać i wznowić MyThread.Paused := false operację gwintu.

Aby anulować wątek, zadzwoń pod numer MyThread.Free.

Aby otrzymywać na bieżąco wysłanych wiadomości z wątku, patrz poniższy przykład:

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. 

i formy:

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

Można również korzystać z bibliotek wyższego poziomu do gwintowania, jak:

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

Answer 3

Przydatne wprowadzenie do wielowątkowości napisał facet o nazwisku Martin Harvey, wiele lat temu. Jego samouczek można znaleźć pod adresem Embarcadero CC site - wygląda na to, że przesłał przykładową klasę, która robi coś, czego szukasz, ale nie patrzyłem na nią, więc nie mogę powiedzieć tego na pewno.

Answer 4

Jeśli przykładowy kod w numerze answer by LU RD jest zbyt skomplikowany dla Twojego gustu, to być może a Delphi implementation of the .net BackgroundWorker class jest bardziej do twoich potrzeb.

Stosując ten można upuścić komponent na formularzu i dodać teleskopowe dla jego różnych wydarzeń (OnWork, OnWorkProgress, OnWorkFeedback i OnWorkComplete). Komponent będzie wykonywał obsługę zdarzeń OnWork w tle podczas wykonywania innych procedur obsługi zdarzeń z wątku GUI (zwracając uwagę na niezbędne przełączniki kontekstu i synchronizację). Jednak dokładne zrozumienie tego, co możesz i czego nie możesz zrobić z wątków dodatkowych, jest nadal konieczne do napisania kodu w module obsługi zdarzeń OnWork.