Játék a szálakkal I. rész

Ennek a cikknek az apropója az volt, hogyan tudnék "fájdalom mentesen" szálat létrehozni, feladatot végeztetni vele majd felszabadítani és egyszerű legyen használni. (a fájdalom mentes itt azt jelenti, hogy ne leakel-jen a program) Mindezt Delphi környezetben.
Az alábbi szál tipikusan olyan használatra alkalmas, amikor valamilyen műveletet kell végrehajtani a háttérben és ha az befejeződött, akkor felszabadítja a szálat.

A szál kódja az alábbi:

unit UTestThread;

interface

uses
  Classes;

type
  TProgressChanged = procedure (Sender : TObject; AProgress : Integer) of object;

  TestThread = class(TThread)
  private
    { Private declarations }
    FProgress           : Integer;
    FOnProgressChanged  : TProgressChanged;
  protected
    procedure SyncDoOnProgressChanged;
    procedure DoOnProgressChanged; virtual;
    procedure Execute; override;
  public
    constructor Create(AOnProgressChangeCallBack : TProgressChanged; AOnTerminateCallBack : TNotifyEvent);
    destructor Destroy; override;

    property OnProgressChanged : TProgressChanged read FOnProgressChanged write FOnProgressChanged;
  end;

implementation

uses
  SysUtils;

{ TestThread }

constructor TestThread.Create(AOnProgressChangeCallBack: TProgressChanged;
  AOnTerminateCallBack: TNotifyEvent);
begin
  inherited Create(True);
  FreeOnTerminate := False;
  Priority := tpNormal;
  FOnProgressChanged := AOnProgressChangeCallBack;
  Self.OnTerminate := AOnTerminateCallBack;
  Resume;
end;

destructor TestThread.Destroy;
begin

  inherited Destroy;
end;

procedure TestThread.DoOnProgressChanged;
begin
  if Assigned(OnProgressChanged) then
    FOnProgressChanged(Self, FProgress);
end;

procedure TestThread.Execute;
begin
  if Terminated then
    Exit;

  FProgress := 0;
  while (FProgress < 1000) and
        (not Terminated)
  do
    begin
      Inc(FProgress);
      SyncDoOnProgressChanged;
      Sleep(100);
    end;
end;

procedure TestThread.SyncDoOnProgressChanged;
begin
  Synchronize(DoOnProgressChanged);
end;

end.

A szál létrehozásakor a szál konstruktorában két callback függvényt kell megadni. Az egyik ami a folyamat állapotát aktualizálja, a másik pedig a szál befejeződésekor hívódik meg.

A szálat vezérlő modul kódja pedig így néz ki:

...
const
  WM_FREE_THREAD  = WM_USER + 1;

type
  TfrmMainTest = class(TForm)
    btnStart: TButton;
    ed1: TEdit;
    btnStop: TButton;
    procedure btnStartClick(Sender: TObject);
    procedure btnLeakClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FThread : TestThread;

    procedure OnThreadFinished(Sender : TObject);
    procedure OnProgressChanged(Sender : TObject; AProgress : Integer);
    procedure StopWorkerThread;
  public
    { Public declarations }
    procedure WndProc(var Message: TMessage); override;

    destructor Destroy; override;
  end;

var
  frmMainTest: TfrmMainTest;

implementation

uses Math;

{$R *.dfm}

procedure TfrmMainTest.btnStartClick(Sender: TObject);
begin
  btnStart.Enabled := False;
  if not Assigned(FThread) then
    begin
      FThread := TestThread.Create(OnProgressChanged, OnThreadFinished);
    end;
end;

procedure TfrmMainTest.OnProgressChanged(Sender: TObject;
  AProgress: Integer);
begin
  ed1.Text := IntToStr(AProgress);
end;

procedure TfrmMainTest.OnThreadFinished(Sender: TObject);
begin
  PostMessage(Handle, WM_FREE_THREAD, 0, 0);
end;

procedure TfrmMainTest.StopWorkerThread;
begin
  if (FThread <> nil) then
    begin
      FThread.Terminate;
      FThread.WaitFor;
      FreeAndNil(FThread);
      btnStart.Enabled := True;
    end;
end;

procedure TfrmMainTest.WndProc(var Message: TMessage);
begin
  if (Message.Msg = WM_FREE_THREAD) then
    StopWorkerThread
  else
    inherited WndProc(Message);
end;

procedure TfrmMainTest.btnStopClick(Sender: TObject);
begin
  if Assigned(FThread) then
    begin
      FThread.Terminate;
    end;
end;

destructor TfrmMainTest.Destroy;
begin

  inherited Destroy;
end;

procedure TfrmMainTest.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  StopWorkerThread;
end;
...

Az elindított szál minden esetben felszabadul és a szál futása is megszakítható.