Завершил ли поток свою работу?

[bilibian]

Привет.

Делаю так:

var
  Check: array of TCheck;

procedure TForm1.btn1Click(Sender: TObject);
  var
    i : Integer;
begin
  SetLength( Check, 10 );
  for i := 0 to Length(Check) - 1 do begin
    Check[i] := TCheck.Create(True);
    Check[i].FreeOnTerminate := True;
    Check[i].Priority := tpNormal;
    Check[i].Resume;
  end;
end;

Как узнать, что какой-то элемент массива Check уже завершил свою работу в потоке?

Например, я дал работу этим 10 потокам. Какой-то поток справился быстрее всех. В OnTerminate проверяем есть ли еще работа. Если есть, то запускаем еще 1 поток для выполнения под тем же индексом в массиве Check, что и завершенный.

Что-то вроде:

for i := 0 to Length(Check) - 1 do
  if Check[i].Terminated then begin
     Check[i] := TCheck.Create(True);
     Check[i].FreeOnTerminate := True;
     Check[i].Priority := tpNormal;
     Check[i].Resume;
  end;

[min@y™]

не читая вопроса, сразу говорю: замени

var
  Check: array of TCheck;

на

var
  Check: TThreadList;

Ещё лучше – напиши наследника от TObjectList<TThread>. Дальнейшая работа с тредами сразу упростится.

Читаю дальше...

[come-on]

Может вам про пул потоков посмотреть, и воспользоваться каким готовым?

[min@y™]

Как узнать, что какой-то элемент массива Check уже завершил свою работу в потоке?

дык, в OnTerminate жэж попадает указатель на вызывающий событие объект! и только после возврата из обработчика срабатывает деструктор, если FreeOnTerminate.

[bilibian]

Сообщение от min@y™

дык, в OnTerminate жэж попадает указатель на вызывающий событие объект! и только после возврата из обработчика срабатывает деструктор, если FreeOnTerminate.

А как мне получить указатель в OnTerminate на текущий тред?

var
  Check: array of TCheck;

procedure TForm1.btn1Click(Sender: TObject);
  var
    i : Integer;
begin
  SetLength( Check, 10 );
  for i := 0 to Length(Check) - 1 do begin
    Check[i] := TCheck.Create(True);
    Check[i].FreeOnTerminate := True;
    Check[i].OnTerminate := Term;
    Check[i].myindex := i;
    Check[i].Priority := tpNormal;
    Check[i].Resume;
  end;
end;

procedure TForm1.Term(Sender: TObject);
begin
  Check[ Check[?].myindex ] := nil;
end;

[bilibian]

Сообщение от min@y™

не читая вопроса, сразу говорю: замени

var
  Check: array of TCheck;

на

var
  Check: TThreadList;

А в деструкторе треда корректно ли удалять элементы этого списка?

destructor TCheck.Destroy;
begin
  with Check.LockList do
    try
      Delete(myindex);
    finally
      Check.UnlockList;
    end;
end;

[min@y™]

А как мне получить указатель в OnTerminate на текущий тред?

Sender.

procedure TCheck.Term(Sender: TObject);
var
  idx: Integer;
begin
  // если заменишь массив на список:
  idx:= Check.IndexOf(Sender);
  if idx <> -1
    then Check.Delete(idx);
end;

[min@y™]

А в деструкторе треда корректно ли удалять элементы этого списка?

не надо удалять в деструкторе ничего, кроме дочерних объектов. иначе высока вероятность долгого секса с дебаггером.

[min@y™]

вот кусок моего древнего проекта времён delphi 7.

  // Класс - очередь потоков, исполняющий их один за другим по порядку
  TThreadQueue = class(TObjectQueue)
  private
    FInProgress: Boolean;
    FCurrentThread: TThread;
    procedure OnThreadTerminate(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;

    procedure ExecuteThreads;
    procedure TerminateCurrentThread;
    procedure TerminateAllThreads;

    property InProgress: Boolean read FInProgress;
    property CurrentThread: TThread read FCurrentThread;
  end;

implementation

{ TThreadQueue }

constructor TThreadQueue.Create;
begin
  inherited;
  FInProgress:= False;
  FCurrentThread:= nil;
end;

destructor TThreadQueue.Destroy;
begin
  if Assigned(FCurrentThread)
    then begin
           FCurrentThread.OnTerminate:= nil;
           FCurrentThread.Terminate();
         end;

  while Count <> 0 do
    TThread(Pop()).Free();

  inherited;
end;

procedure TThreadQueue.ExecuteThreads;
begin
  if (Self.Count <> 0) 
    then begin
           FInProgress:= True;
           FCurrentThread:= TThread(Pop());
           FCurrentThread.OnTerminate:= OnThreadTerminate;
           FCurrentThread.Resume();
         end
    else FInProgress:= False;
end;

procedure TThreadQueue.OnThreadTerminate(Sender: TObject);
begin
  FCurrentThread:= nil;
  ExecuteThreads();
end;

procedure TThreadQueue.TerminateCurrentThread;
begin
  if Assigned(FCurrentThread)
    then FCurrentThread.Terminate();
end;

procedure TThreadQueue.TerminateAllThreads;
var
  T: TThread;
begin
  // очистка очереди
  if Assigned(FCurrentThread)
    then begin
           FCurrentThread.OnTerminate:= nil;
           FCurrentThread.Terminate();
           FCurrentThread:= nil;
         end;

  while Self.Count <> 0 do
    begin
      T:= TThread(Self.Pop());
      T.Free();
    end;

  FInProgress:= False;
end;

Caution! This source is not for copypaste!

[bilibian]

При создании потока у меня передается много параметров в поток.

var
  Check: array of TCheck;

procedure TForm1.btn1Click(Sender: TObject);
  var
    i : Integer;
begin
  SetLength( Check, 10 );
  for i := 0 to Length(Check) - 1 do begin
    Check[i] := TCheck.Create(True);
    Check[i].FreeOnTerminate := True;
    Check[i].p1 := param1;
    Check[i].p2 := param2;
    Check[i].p3 := param3;
    Check[i].Priority := tpNormal;
    Check[i].Resume;
  end;
end;

В случае, если я заменю:

var
  Check: array of TCheck;

на:

var
  Check: TThreadList;

То как мне создать поток с помощью списка и передать все эти параметры?

var
  Check: TThreadList;

procedure TForm1.btn1Click(Sender: TObject);
begin
  Check := TThreadList.Create;
  Check.Add( TCheck.Create(param1,param2,param3) );
end;

var
  param1,param2,param3:string  

constructor TCheck.Create(param1,param2,param3:string);
begin
  inherited;
  p1 := param1;
  p2 := param2;
  p3 := param3;
end;