Dynamiczne tworzenie równoległych wątków

// PIERWSZY JĘZYK
 TWatek_Jezyk_1 = class(TThread)
 private
 protected
   procedure Execute; override;
 end;

procedure TWatek_Jezyk_1.Execute;
begin
  FreeOnTerminate := True;
  while not (Application.Terminated) or (Terminated) do
    begin
       // Tworzenie plików dla 1 języka
    end;
end;

// DRUGI JĘZYK
 TWatek_Jezyk_2 = class(TThread)
 private
 protected
   procedure Execute; override;
 end;

procedure TWatek_Jezyk_2.Execute;
begin
  FreeOnTerminate := True;
  while not (Application.Terminated) or (Terminated) do
    begin
       // Tworzenie plików dla 2 języka
    end;
end;

var
   SL_LANG       : TStringList;
   MEM_INI       : TMemIniFile;
   sConfigFile   : string;

   sLangSection      : string;
   i                 : Integer;
   iInstall          : Integer;
   iOfficial         : Integer;
begin
   result := True;

   sConfigFile := AInstallDir + '\' + 'LangConfig.ini';
   MEM_INI := TMemIniFile.Create(sUFMConfigINI);

   SL_LANG := TStringList.Create;
   MEM_INI := TMemIniFile.Create(sConfigFile);
   try
      MEM_INI.ReadSections(SL_LANG); // Load Sections (1045 | 1033 | etc)
      for i := 0 to SL_LANG.Count-1 do
         begin
            sLangSection := SL_LANG.Strings[i];

            iInstall     := MEM_INI.ReadInteger(sLangSection, 'Install', 0); // Install Language
            iOfficial    := MEM_INI.ReadInteger(sLangSection, 'Official', 0); // Official language
            if (iInstall = 1) AND (iOfficial = 1) then
               begin
                  result := CREATE_FILE_FOR_GIVEN_LANGUAGE_ACTION(AInstallDir, sLangSection);
               end; // Supported Languages
         end; // Lang Loop
   finally
      SL_LANG.Free;
      MEM_INI.Free;
   end;
end;

type
  TlanguageThread = class(TThread)
  public
    languageId: integer;
  protected
    procedure Execute; override;
  end;

procedure TlanguageThread.Execute;
begin
  FreeOnTerminate := true;
  case languageId of
    1:
      // jakaś akcja 1
      ;
    2:
      // jakaś akcja 2
      ;
    3:
      // jakaś akcja 3
      ;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  lThread: TlanguageThread;
begin
  for i := 1 to 3 do
  begin
    lThread := TlanguageThread.Create(true);
    lThread.languageId := i;
    lThread.Start;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  lThread: TlanguageThread;
begin
 threadsCounter := 3;
  for i := 1 to 3 do
  begin
    lThread := TlanguageThread.Create(true);
    lThread.languageId := i;
    lThread.Start;
  end;
  while threadsCounter <> 0 do
    sleep(100);
  showmessage('Wszytskie wątki zamknięte ');
end;

unit Unit2;

interface

uses
  Classes, Windows, system.SyncObjs;

type
  TlanguageThread = class(TThread)
  public
    languageId: integer;
  protected
    procedure Execute; override;
  end;

var
  threadsCounter: integer;

implementation

procedure TlanguageThread.Execute;
begin
  self.FreeOnTerminate := true;
  try
    case languageId of
      1:
        // jakaś akcja 1
        ;
      2:
        // jakaś akcja 2
        ;
      3:
        // jakaś akcja 3
        ;
    end;
  finally
    TInterlocked.Decrement(threadsCounter);
  end;
end;

var
  languagesCount: integer;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  lThread: TlanguageThread;
begin
  languagesCount := 3; /// albo jakakolwiek inna wartość

  threadsCounter := languagesCount;
  for i := 1 to languagesCount do
  begin
    lThread := TlanguageThread.Create(true);
    lThread.languageId := i;
    lThread.Start;
  end;
  while tinterlocked.Add(threadsCounter, 0) <> 0 do
    sleep(100);
  showmessage('Wszytskie wątki zamknięte ');
end;

type
  TlanguageThread = class(TThread)
  public
    languageId: integer;
  protected
    procedure processLanguage(aId: integer);
    procedure Execute; override;
  end;

var
  threadsCounter: integer;

implementation

procedure TlanguageThread.Execute;
begin
  self.FreeOnTerminate := true;
  try
    processLanguage(self.languageId);
  finally
    TInterlocked.Decrement(threadsCounter);
  end;
end;

procedure TlanguageThread.processLanguage(aId: integer);
begin
  // tutaj obsługa wątku w zależności od wartości aID
end;

TProgressFrm.UFM_SYSINFO_GET_SYSTEM_INFORMATION_DATA(var Msg: TMessage);
....
  while TInterLocked.Add(ThreadsCounter, 0) <> 0 do Sleep(50);
....

procedure TProgressFrm.Timer1Timer(Sender: TObject);
begin
  if TInterLocked.Add(ThreadsCounter, 0) <> 0 then
    exit;
  ModalResult := mrOK;
end;

unit Progress_Form;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, System.SyncObjs, Vcl.ExtCtrls;

type
  TMyMultiThread = class(TThread)

  public
    Thread_Action: Integer;
  private
    procedure SYNCHRONIZE_AVAILABLE_DATA;
  protected
    procedure GET_AVAILABLE_DATA(AAction: Integer);
    procedure Execute; override;
  end;

var
  ThreadsCounter: Integer = 0;

const
  USER_MSG = wm_User + 1;

type
  TProgressFrm = class(TForm)
    Lbl_Action: TLabel;
    PB_Action: TProgressBar;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    procedure UFM_SYSINFO_GET_SYSTEM_INFORMATION_DATA(var Msg: TMessage); message USER_MSG;
  public
    { Public declarations }
  end;

var
  ProgressFrm: TProgressFrm;

implementation

{$R *.dfm}

procedure TProgressFrm.FormCreate(Sender: TObject);
begin
  //
end;

procedure TProgressFrm.FormActivate(Sender: TObject);
begin
  ProgressFrm.PB_Action.Position := 0;
  ProgressFrm.Update;

  PostMessage(Handle, USER_MSG, 0, 0);
end;

procedure TProgressFrm.FormShow(Sender: TObject);
begin
  //
end;

procedure TProgressFrm.Timer1Timer(Sender: TObject);
begin
  if TInterLocked.Add(ThreadsCounter, 0) <> 0 then
    exit;
  ModalResult := mrOK;
end;

procedure TProgressFrm.UFM_SYSINFO_GET_SYSTEM_INFORMATION_DATA(var Msg: TMessage);
var
  lThread: TMyMultiThread;
  i: Integer;
  iThreadNo: Integer;
begin
  iThreadNo := 5;

  ThreadsCounter := iThreadNo;
  for i := 1 to iThreadNo do
  begin
    lThread := TMyMultiThread.Create(True);
    lThread.Priority := tpNormal; // tpHighest;
    lThread.Thread_Action := i;
    lThread.Start;
  end;
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// tutaj  była  pętla która wstrzymywała przetwarzanie komunikatów i tym samym blokowała wykonanie metody Synchronize. 
// pętla czekała na zakończenie wątków, a wątki czekały na wykonanie Synchronize, powstawało zakleszczenie i zwiecha aplikacji
// 

end;

procedure TMyMultiThread.Execute;
begin
  self.FreeOnTerminate := True;
  try
    GET_AVAILABLE_DATA(self.Thread_Action);


    // IT HANGS!!!!!!
    // HOW TO PASS PARAMETER INTO SYNCHRONIZE PROCEDURE? (TO KNOW WHAT ACTION IS DONE)
    // Synchronize(SYNCHRONIZE_AVAILABLE_DATA);

  finally
    TInterLocked.Decrement(ThreadsCounter);
  end;
end;

procedure TMyMultiThread.GET_AVAILABLE_DATA(AAction: Integer);
begin
  sleep(random(2000));
  synchronize(self.SYNCHRONIZE_AVAILABLE_DATA);
end;

// HOW TO USE SYNCHRONIZE?!!!!!
// HOW TO SHOW PROGRESS FOR DIFFERENT THREAD WITH PROGRESSBAR AND ACTION DESCRIPTION IN LABEL
procedure TMyMultiThread.SYNCHRONIZE_AVAILABLE_DATA();
begin
  ProgressFrm.Lbl_Action.Caption := 'Some text (different for different thread)...'+  inttostr(self.Thread_Action);
  ProgressFrm.PB_Action.StepBy(10);
end;

initialization 
  randomize;

end.

procedure TMyMultiThread.Execute;
begin
 self.FreeOnTerminate := True;
  try
    GET_AVAILABLE_DATA(self.Thread_Action);

    // IT HANGS!!!!!!
    // HOW TO PASS PARAMETER INTO SYNCHRONIZE PROCEDURE? (TO KNOW WHAT ACTION IS DONE)
    // Synchronize(SYNCHRONIZE_AVAILABLE_DATA);

  finally
    if TInterLocked.Decrement(ThreadsCounter)=0 then 
     // ostatni wątek zamyka formę
      ProgressFrm.close;

  end;

var
  ProgressFrm: TProgressFrm;

procedure TMyMultiThread.Execute;
begin
   Self.FreeOnTerminate := True;
   try
      GET_AVAILABLE_DATA(Self.Thread_Action);
   finally
      if TInterLocked.Decrement(ThreadsCounter) = 0 then 
         begin
            Synchronize(self.SYNCHRONIZE_JOB_FINISHED);  // To ma wyświetlić info, odczekać 1s i zamknąć formę...
         end;
   end;
end;

procedure TMyMultiThread.SYNCHRONIZE_JOB_FINISHED;
begin
   ProgressFrm.Lbl_Action.Caption := 'Action Finished!';
   ProgressFrm.Lbl_Action.Update;

   ProgressFrm.PB_Action.Position := 100;      
   ProgressFrm.PB_Action.Update;   
   ProgressFrm.Update;

   Sleep(1000);
   ProgressFrm.ModalResult := mrOK;
end;

unit Progress_Form;
interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, System.SyncObjs, Vcl.ExtCtrls;

type
  TMyMultiThread = class(TThread)

  public
    Thread_Action: Integer;
    onAfterExecute: TNotifyEvent;
    pb: TprogressBar;
    lbl: Tlabel;
  private
    procedure SYNCHRONIZE_AVAILABLE_DATA;
  protected
    procedure GET_AVAILABLE_DATA(AAction: Integer);
    procedure Execute; override;
    procedure AfterConstruction; override;
  end;

var
  ThreadsCounter: Integer = 0;

const
  USER_MSG = wm_User + 1;

type
  TProgressFrm = class(TForm)
    Lbl_Action: Tlabel;
    PB_Action: TprogressBar;
    procedure FormCreate(sender: tobject);
    procedure FormActivate(sender: tobject);
    procedure FormShow(sender: tobject);

  private
    { Private declarations }
    procedure UFM_SYSINFO_GET_SYSTEM_INFORMATION_DATA(var Msg: TMessage); message USER_MSG;
    procedure onThreadClose(sender: tobject);
  public
    { Public declarations }
  end;

implementation

{$R *.dfm}

procedure TProgressFrm.FormCreate(sender: tobject);
begin
  randomize;
end;

procedure TProgressFrm.FormActivate(sender: tobject);
begin
  self.PB_Action.Position := 0;
  self.Update;

  PostMessage(Handle, USER_MSG, 0, 0);
end;

procedure TProgressFrm.FormShow(sender: tobject);
begin
  //
end;

procedure TProgressFrm.onThreadClose(sender: tobject);
begin
  if TInterLocked.Add(ThreadsCounter, 0) <> 0 then
    exit;
  ModalResult := mrOK;
end;

procedure TProgressFrm.UFM_SYSINFO_GET_SYSTEM_INFORMATION_DATA(var Msg: TMessage);
var
  lThread: TMyMultiThread;
  i: Integer;
  iThreadNo: Integer;
begin
  iThreadNo := 5;

  ThreadsCounter := iThreadNo;
  for i := 1 to iThreadNo do
  begin
    lThread := TMyMultiThread.Create(True);
    lThread.Priority := tpNormal; // tpHighest;
    lThread.Thread_Action := i;
    lThread.pb := self.PB_Action;
    lThread.lbl := self.Lbl_Action;
    lThread.onAfterExecute := self.onThreadClose;
    lThread.Start;
  end;
end;

procedure TMyMultiThread.AfterConstruction;
begin
  inherited;
  self.onAfterExecute := nil;
  self.pb := nil;
end;

procedure TMyMultiThread.Execute;
begin
  self.FreeOnTerminate := True;
  try
    GET_AVAILABLE_DATA(self.Thread_Action);


    // IT HANGS!!!!!!
    // HOW TO PASS PARAMETER INTO SYNCHRONIZE PROCEDURE? (TO KNOW WHAT ACTION IS DONE)
    // Synchronize(SYNCHRONIZE_AVAILABLE_DATA);

  finally
    TInterLocked.Decrement(ThreadsCounter);
  end;
  if assigned(self.onAfterExecute) then
    self.onAfterExecute(self);
end;

procedure TMyMultiThread.GET_AVAILABLE_DATA(AAction: Integer);
begin
  sleep(random(2000));
  synchronize(self.SYNCHRONIZE_AVAILABLE_DATA);

end;

// HOW TO USE SYNCHRONIZE?!!!!!
// HOW TO SHOW PROGRESS FOR DIFFERENT THREAD WITH PROGRESSBAR AND ACTION DESCRIPTION IN LABEL
procedure TMyMultiThread.SYNCHRONIZE_AVAILABLE_DATA();
begin
  if assigned(self.lbl) then
    self.lbl.Caption := 'Some text (different for different thread)...' + inttostr(self.Thread_Action);
  if assigned(self.pb) then
    pb.StepBy(10);
end;

end.

procedure TMainFrm.FormCreate(Sender: TObject);
var
  ProgressFrm: TProgressFrm;
begin
  // DO SOME BASIC STUFF

  // CREATE PROGRESS FORM
  try
    try
      ProgressFrm := TProgressFrm.Create(Application);
      ProgressFrm.ShowModal; // MUST BE MODAL!
      ProgressFrm.Update;
    except
      ShowMessage('Something went wrong!');
    end;
  finally
    freeandnil(ProgressFrm);
  end;
end;

procedure TProgressFrm.FormActivate(Sender: TObject);
begin
  ProgressFrm.PB_Action.Position := 0;
  ProgressFrm.Update;

  PostMessage(Handle, USER_MSG, 0, 0);
end;

procedure TProgressFrm.FormActivate(Sender: TObject);
begin
  self.PB_Action.Position := 0;
  self.Update;

  PostMessage(Handle, USER_MSG, 0, 0);
end;

procedure TProgressFrm.onThreadClose(sender: tobject);
begin
  if TInterLocked.Add(ThreadsCounter, 0) <> 0 then
    exit;
  self.Lbl_Action.Caption := 'Wątki zamknięte';
  sleep(3000);
  ModalResult := mrOK;
end;

[dcc32 Hint] Progress_Form.pas(23): H2269 Overriding virtual method 'TMyMultiThread.AfterConstruction' has lower visibility (protected) than base class 'TThread' (public)

TMyMultiThread.SYNCHRONIZE_AVAILABLE_DATA();

case self.Thread_Action of
    1: // Thread 1
      begin
        // Do Something (Thread 1)
        if assigned(self.LBL) then
          self.LBL.Caption := 'Gathering Operating System Information (' + inttostr(self.Thread_Action) + ')';
      end;

procedure TMyMultiThread.SYNCHRONIZE_AVAILABLE_DATA();
begin
  if assigned(self.LBL) then
    case self.Thread_Action of
      1: // Thread 1
        self.LBL.Caption := 'Gathering Operating System Information (' + inttostr(self.Thread_Action) + ')';
      2: // Thread 2
        self.LBL.Caption := 'Gathering Computer System Information (' + inttostr(self.Thread_Action) + ')';
      3: // Thread 3
        self.LBL.Caption := 'Gathering Operating Memory Information (' + inttostr(self.Thread_Action) + ')';
      4: // Thread 4
        self.LBL.Caption := 'Gathering Processor (CPU) Information (' + inttostr(self.Thread_Action) + ')';
      5: // Thread 5
        self.LBL.Caption := 'Gathering Video Controller Information (' + inttostr(self.Thread_Action) + ')';
    end;
  if assigned(self.PB) then
  begin
    PB.Position := PB.Position + 20;
    PB.Update;
  end;
end;

procedure TProgressFrm.onThreadClose(Sender: TObject);
begin
  if TInterLocked.Add(ThreadsCounter, 0) <> 0 then
    exit;

  self.Lbl_Action.Caption := 'Wątki zamknięte';
  application.ProcessMessages;

  Sleep(3000); // !!!!
  ModalResult := mrOK;
end;