Pourquoi les threads fonctionnent-ils en série dans cette application de console?

à tout le moins que vous devriez mettre xxx

à l'extérieur de la boucle principale. Cette boucle d'attente est ce qui cause la maintien. Pour chaque entier I du Mainloop, il attend que la FtheadCount tombe à zéro.

sur un Sidenote: Normalement, vous n'avez pas besoin de protéger les variables locales avec des sections critiques. Bien que les messages de traitement dedans, il puisse subir des objets, car il peut provoquer une réintensif.

J'ai une unité qui fait exactement ce dont vous avez besoin. Il suffit de le télécharger à partir de:

Cromis.threading

à l'intérieur, vous avez deux classes:

1. Ttaskpool: Piscine de tâches. Manière facile de faire des choses asynchrones.
2. TtaskQueue: une file d'attente de tâches asynchrones. Fonctionne comme une file d'attente FIFO standard.

   Le TtaSkQueue peut être utilisé autonome avec des filets de Vanila simples par exemple. Il bloque à l'intérieur d'un seul fil et files d'attente les demandes.

   Si cela ne suffit pas, vous pouvez vérifier l'omnithreadlibrary à:

   omnithreadlibrary

   Ceci est une puissant bibliothèque de filetage, de loin supérieure à ce que j'ai. Mais aussi plus compliqué à utiliser (mais toujours très facile par rapport au filetage classique).

J'ai suivi la suggestion de Marjan et le code suivant semble fonctionner correctement. Je réponds à ma propre question afin de fournir un code de réponse, qui peut être analysé par d'autres personnes et corrigé si nécessaire.

unit Unit1;

interface

uses
  SysUtils, Classes, SyncObjs, Windows, Forms, Dialogs;

var   FCritical: TRTLCriticalSection;  

type
  TTestThread = class(TThread)
  protected
    procedure Execute;override;
  end;
  TDataModule1 = class(TDataModule)
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Déclarations privées }
  public

    procedure execute;
    procedure CreateThread();
    procedure Onterminatethrd(Sender: TObject);
  end;

var
  DataModule1       : TDataModule1;
  FthreadCount      : Integer;


implementation

{$R *.dfm}

{ TTestThread }

procedure TTestThread.Execute;
var
  f                 : TextFile;
  i                 : integer;

begin
 AssignFile(f, 'd:\a\a' + inttostr(FthreadCount) + '.txt');
 if fileexists('d:\a\a' + inttostr(FthreadCount) + '.txt') then
  Append(f)
 else
  Rewrite(f);
   try
    i := 0;
    while i <= 1000000 do
      Inc(i);
  Writeln(f, 'done '+floattostr(self.Handle));
  finally
    CloseFile(f);
  end;
end;

{ TDataModule1 }

procedure TDataModule1.CreateThread;
var
  aThrd             : TTestThread;
begin
  aThrd := TTestThread.Create(True);
  aThrd.FreeOnTerminate := True;
  EnterCriticalSection(fcritical);
  Inc(FthreadCount);
  LeaveCriticalSection(fcritical);
  aThrd.OnTerminate:=Onterminatethrd;
  try
    aThrd.Resume;
  except
    FreeAndNil(aThrd);
  end;
end;

procedure TDataModule1.Onterminatethrd(Sender: TObject);
begin
  EnterCriticalSection(fcritical);
    Dec(FthreadCount);
  LeaveCriticalSection(fcritical);
end;

procedure TDataModule1.DataModuleCreate(Sender: TObject);
begin
  InitializeCriticalSection(fcritical);
end;

procedure TDataModule1.DataModuleDestroy(Sender: TObject);
begin
  DeleteCriticalSection(fcritical);
end;

procedure TDataModule1.execute;
var
  i                 : integer;
begin
  i := 0;
 try
  while i < 1000 do
  begin
    while (FthreadCount = 10) do
     begin
      Application.ProcessMessages;
      CheckSynchronize
     end;
    CreateThread;
    Inc(i);
  end;
    while FthreadCount > 0 do
    begin
      Application.ProcessMessages;
      CheckSynchronize;
    end;
 except on e:Exception do
//
 end;
end;

end.