- Регистрация
- 1 Мар 2015
- Сообщения
- 1,467
- Баллы
- 155
Вопрос заданный одним из участников форума 
	
	
	
		
Ответ
Можно так
	
	
	
		
или вот мой рабочий код
	
	
	
		
				
			
		Код:
	
	Есть потоки, запуск: for j := 1 to CountPotok do //количество потоков
 begin apiThread:=TapiThread.Create(False); 
apiThread.Priority:=tpLowest; 
apiThread.FreeOnTerminate:=True;
 end;Можно так
		Код:
	
	try
    // Подготовка объектов и необходимых данных для них
    ...
    EnterWorkerThread;
    try
      // Сюда пиши код, который у тебя в Execute
    finally
      LeaveWorkerThread;
    end;
     // Работа с новыми/старыми объектами
     ...
  finally
    // Уничтожение всего того, что было создано
  end;
		Код:
	
	TThr = class (TThread)
  protected
    procedure Execute(); override;
  public
    FThrName : String; //Имя потока.
    //Точка входа в процедуру, которую должен будет выполнять поток.
    FProc : procedure(aThr : TThr);
    FPCnt : ^Integer; //Указатель на счётчик потоков.
    FLog : TStrings; //Журнал.
    FSData : String; //Строковые данные для вывода в журнал.
    procedure WriteLog; //Метод для записи в журнал.
    procedure IsTerminate(Sender : TObject); //Обработчик события OnTerminate.
  end;
var
  Form1: TForm1;
  //Счётчик работающих потоков.
  Cnt : Integer = 0;
  //Массив потоков. Если ArrThr = nil - это означает, что нет ни одного потока.
  ArrThr : array of TThr = nil;
implementation
{$R *.dfm}
//Набор процедур, которые могут выполняться в потоках.
procedure Proc1(aThr : TThr);
const
  SelfName = 'Proc1()';
var
  i : Integer;
begin
  with aThr do begin
    FSData := FThrName + ': Запуск...';
    Synchronize(WriteLog);
    for i := 1 to 10 do begin
      if Terminated then Exit;
      Sleep(500); //Задержка на 0.5 секунды.
      FSData := FThrName + ', ' + SelfName + ', Выполнение: ' + IntToStr(i);
      Synchronize(WriteLog);
    end;
  end;
end;
procedure Proc2(aThr : TThr);
const
  SelfName = 'Proc2()';
var
  i : Integer;
begin
  with aThr do begin
    FSData := FThrName + ': Запуск...';
    Synchronize(WriteLog);
    for i := 1 to 10 do begin
      if Terminated then Exit;
      Sleep(1000); //Задержка на 1 секунду.
      FSData := FThrName + ', ' + SelfName + ', Выполнение: ' + IntToStr(i);
      Synchronize(WriteLog);
    end;
  end;
end;
procedure Proc3(aThr : TThr);
const
  SelfName = 'Proc3()';
var
  i : Integer;
begin
  with aThr do begin
    FSData := FThrName + ': Запуск...';
    Synchronize(WriteLog);
    for i := 1 to 10 do begin
      if Terminated then Exit;
      Sleep(1500); //Задержка на 1.5 секунды.
      FSData := FThrName + ', ' + SelfName + ', Выполнение: ' + IntToStr(i);
      Synchronize(WriteLog);
    end;
  end;
end;
{ TThr }
procedure TThr.Execute;
begin
  OnTerminate := IsTerminate; //Подключаем обработчик события OnTerminate.
  if Assigned(FProc) then FProc(Self); //Запуск процедуры в потоке.
end;
procedure TThr.IsTerminate(Sender : TObject);
begin
  with Sender as TThr do begin
    //При завершении потока уменьшаем счётчик потоков на единицу.
    if FPCnt <> nil then Dec(FPCnt^);
    FSData := FThrName + ': Поток завершён.';
    WriteLog;
  end;
end;
procedure TThr.WriteLog;
begin
  FLog.Add(FSData); //Запись в журнал.
end;
{ TForm1 }
//Запуск потоков.
procedure TForm1.Button1Click(Sender: TObject);
var
  i : Integer;
begin
  if Cnt > 0 then begin
    ShowMessage('Работа потоков пока не завершена. Ожидайте завершения.');
    Exit;
  end;
  //Создаём группу потоков.
  Randomize;
  Cnt := 3 + Random(6); //Количество потоков: 3..8.
  SetLength(ArrThr, Cnt);
  for i := 0 to High(ArrThr) do begin
    ArrThr[i] := TThr.Create(True);
    ArrThr[i].FThrName := 'Поток №' + IntToStr(i + 1);
    ArrThr[i].FPCnt := @Cnt;
    ArrThr[i].FLog := Memo1.Lines;
    //Задание для потока.
    case i mod 3 of
      0 : ArrThr[i].FProc := Proc1;
      1 : ArrThr[i].FProc := Proc2;
    else
      ArrThr[i].FProc := Proc3;
    end;
  end;
  //Запуск потоков.
  for i := 0 to High(ArrThr) do ArrThr[i].Resume;
  //Ожидаем завершения всех потоков.
  while Cnt > 0 do begin
    Application.ProcessMessages;
  end;
  //Удаляем потоки из памяти.
  for i := 0 to High(ArrThr) do FreeAndNil(ArrThr[i]);
  ArrThr := nil;
  Memo1.Lines.Add('--------------------------------------------------');
  Memo1.Lines.Add('Все потоки завершены.');
  Memo1.Lines.Add('--------------------------------------------------');
end;
//Установка флага досрочного завершения для всех потоков.
procedure TForm1.Button2Click(Sender: TObject);
var
  i : Integer;
begin
  if ArrThr = nil then begin
    ShowMessage('Нет выполняющихся потоков. Действие отменено.');
    Exit;
  end;
  //Устанавливаем для потоков флаг завершения.
  for i := 0 to High(ArrThr) do ArrThr[i].Terminate;
  Memo1.Lines.Add('--------------------------------------------------');
  Memo1.Lines.Add('Установлен флаг завершения.');
  Memo1.Lines.Add('--------------------------------------------------');
end;
//Запрет завершения программы до момента завершения всех потоков.
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  //Мы проверяем ArrThr = nil, а не Cnt = 0 - потому что после обнуления счётчика
  //Cnt объекты потоков ещё существуют. Поэтому, надёжным способом проверки будет
  //всётаки проверка на ArrThr = nil - это гарантирует, что в данный момент
  //нет ни одного объекта потока.
  CanClose := ArrThr = nil;
  if not CanClose then begin
    ShowMessage(
      'Не все потоки завершены. Дождитесь завершения. Чтобы дать потокам команду'
      + ' на досрочное завершение, нажмите кнопку: "Установить флаг завершения".'
    );
  end;
end; 
				