Почему потоки работают последовательно в этом консольном приложении?

Я создаю консольное приложение, которое должно выполнить несколько потоков для выполнения задачи. Моя проблема состоит в том, что потоки работают один за другим (thread1, запускаются-> работа-> конец и ТОЛЬКО затем запускают thread2) вместо того, чтобы выполнить все в то же время. Также я не хочу, чтобы больше чем 10 потоков работали в то же время (проблемы производительности). Рев является примером кода консольного приложения и используемого datamodule. мое приложение работает над тем же способом. я использовал datamodule, потому что после того, как потоки закончены, я должен заполнить базу данных той информацией. Также существуют комментарии в коде для, объясняют, который является причиной того, чтобы сделать что-то.

код консоли приложений:

    program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Unit1 in 'Unit1.pas' {DataModule1: TDataModule};

var dm:TDataModule1;
begin
   dm:=TDataModule1.Create(nil);
   try
     dm.execute;
   finally
    FreeAndNil(dm);
   end;
end.

и код datamodule

    unit Unit1;

interface

uses
  SysUtils, Classes, SyncObjs, Windows, Forms;

var   FCritical: TRTLCriticalSection;//accessing the global variables  

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;  //know how many threads are running


implementation

{$R *.dfm}

{ TTestThread }

procedure TTestThread.Execute;
var
  f                 : TextFile;
  i                 : integer;
begin
  EnterCriticalSection(fcritical);
  AssignFile(f, 'd:\a' + inttostr(FthreadCount) + '.txt');
  LeaveCriticalSection(fcritical);
  Rewrite(f);
  try
    i := 0;
    while i <= 1000000 do // do some work...
      Inc(i);
    Writeln(f, 'done');
  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;
  while i < 1000 do
  begin
    while (FthreadCount = 10) do
      Application.ProcessMessages;//wait for an thread to finish. max threads at a //time =10

    CreateThread;

    EnterCriticalSection(fcritical);
    Inc(i);
    LeaveCriticalSection(fcritical);

    while FthreadCount > 0 do //wait for all threads to finish in order to close the //main thread
    begin
      Application.ProcessMessages;
      CheckSynchronize;
    end;
  end;
end;

end.

таким образом, поскольку я сказал, что проблема состоит в том, что мои потоки работают один за другим, вместо того, чтобы работать все в то же время. также я видел, что иногда только первый поток работал, после этого все, что остальные просто создают и законченный. в моем приложении весь код защищен попыткой-excepts, но никакие ошибки не повышены.

Кто-то может дать мне совет?