- Регистрация
- 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;