interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

const
  PROGRESS_POS = WM_USER+1;//установка значения
  EXITTHREAD_MESSAGE=WM_USER+2;//выход из потока
type
  TfrmMain = class(TForm)
    ProgressBar1: TProgressBar;
    ProgressBar2: TProgressBar;
    ProgressBar3: TProgressBar;
    ProgressBar4: TProgressBar;
    ProgressBar5: TProgressBar;
    btnStart: TButton;
    btnStop: TButton;
    btnClear: TButton;
    btnExit: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
  private
    { Private declarations }
    procedure SetProgressPos(var Msg: TMessage); message PROGRESS_POS;
    procedure MSExitThread(var Msg: TMessage); message EXITTHREAD_MESSAGE;
  public
    { Public declarations }
  end;

  //процедура выполняемая в отдельном потоке
  procedure procedurePotoc1(aValue:PInteger);stdcall;
const
  countThread=5;//кол-во потоков

var
  frmMain: TfrmMain;
  thread:array[1..countThread] of THandle;//массив для хранения
  threadID:array[1..countThread] of DWORD;
  bStop,vse:Boolean;
  Poriadok:TStringList;
implementation

{$R *.dfm}
//процедура выполняемая в отдельном потоке
procedure procedurePotoc1(aValue:PInteger);stdcall;
var
  i:Integer;
begin
  for I := 0 to 100 do
  begin
    Randomize;
    Sleep(Random(100)+50);
    SendMessage(frmMain.Handle,PROGRESS_POS, aValue^, i);
  end;
  SendMessage(frmMain.Handle,EXITTHREAD_MESSAGE, aValue^, 0);
end;

procedure TfrmMain.btnClearClick(Sender: TObject);
var
  i:Integer;
begin
  for i := 1 to countThread do
  begin
    if thread>0 then //проверка того, что он вообще запускался))
      if TerminateThread(thread,0) then
        thread:=0;
  end;
  ProgressBar1.Position:=0;
  ProgressBar2.Position:=0;
  ProgressBar3.Position:=0;
  ProgressBar4.Position:=0;
  ProgressBar5.Position:=0;
  Poriadok.Clear;
  Memo1.Lines.Clear;
end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
  frmMain.Close;
end;

procedure TfrmMain.btnStartClick(Sender: TObject);
var
  i:Integer;
  n:Integer;
begin
  for i := 1 to countThread do
  begin
    if thread=0 then
    begin
      thread:=CreateThread(nil,0, @procedurePotoc1, @thread, 0, threadID);
    end;
    if (thread = 0) then
      ShowMessage('Поток не создан '+IntToStr(i));
  end;
  Poriadok.Clear;
end;

procedure TfrmMain.btnStopClick(Sender: TObject);
var
  i:Integer;
begin
  for i := 1 to countThread do
  begin
    if bStop then
    begin
      ResumeThread(thread);
    end
    else
    begin
      SuspendThread(thread);
    end;
  end;
  if bStop then
    bStop:=False
  else
    bStop:=True;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  btnClearClick(Self);
  Poriadok.Free;
end;


procedure TfrmMain.FormCreate(Sender: TObject);
begin
  Poriadok:=TStringList.Create;
end;

procedure TfrmMain.MSExitThread(var Msg: TMessage);
var
  i:Integer;
  temp:cardinal;
begin
  temp:=0;
  for I := 1 to countThread do
  begin
    if thread=Msg.WParam then
    begin
      thread:=0;
      Poriadok.Add('"Таракан" №'+IntToStr(i));
    end;
    temp:=temp+thread;
    if temp=0 then//все потоки завершились или нет
      vse:=True
    else
      vse:=False;
  end;
  if vse then//все потоки завершились или нет
    Memo1.Lines:=Poriadok;
end;

procedure TfrmMain.SetProgressPos(var Msg: TMessage);
var
  i:Integer;
  n:Integer;
  hN:THandle;
begin
  for i:= 1 to countThread  do
  begin
    if thread=Msg.WParam then
      TProgressBar(Self.FindComponent('ProgressBar'+IntToStr(i))).Position:=Msg.LParam;
  end;
end;
end.