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

--- > Wzywam wszystkich ekspertów od aplikacji wielowątkowych!!! :)

Mój program (bez GUI) tworzy wiele plików (osobno dla każdego obsługiwanego języka) i zapisuje je w odpowiednim miejscu i formacie na dysku.
W moim odczuciu trwa to jednak nieco za długo (30s). Pomyślałem, że może warto użyć osobnych wątków dla każdego pakietu generowanych plików dla danego języka?
Zaznaczam, że program nie wie ile jest języków (to info odczytuje po uruchomieniu) - wątek może być jeden albo X (np. siedem).

Zatem, potrzeba utworzyć X wątków, które wygenerują pliki dla danego języka w tym samym czasie (teraz robię jeden język po drugim w pętli).
Załóżmy, że mam 5 obsługiwanych języków. Chciałbym, żeby program utworzył X=5 wątków i wykonał je równolegle. Po zakończeniu wszystkich program ma się zamknąć.
Wątki nie muszą komunikować się ze sobą ani synchronizować z głównym wątkiem. Mają zrobić swoją robotę i się zamknąć.

Nie mam pojęcia jak się do tego zabrać, bo też w sumie nigdy nie używałem wątków na poważnie.

Pytanie:

• Jak to zrobić :P
• Jak zadeklarować klasę potomną od TThread dla wielu wątków?
• Co z metodą Execute? Jest wspólna dla wszystkich X wątków czy każdy ma swoją?

Jakby ktoś podrzucił jakiś przykład kodu (nawet najbardziej prymitywny) - byle pokazywał jak odpalić np. 3 wątki...
Głównie chodzi mi o to, że nie wiem ile watków ma być. Normalnie zrobiłbym coś takiego (gdybym wiedział, że wątki są tylko np. 2):

// 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;

Ale jak pisałem nie wiem ile ich ma być...

Być może pytam o proste i oczywiste rzeczy, albo źle zadaję pytanie... nie znam się na programowaniu wielo-wątkowym.
Program jest prosty i potrzebuję tylko przyspieszyć jego działanie.
Mam nadzieję, że rozumiecie o co mi chodzi.

Proszę o pomoc.
Z góry dziękuję.

kod ze środka pętli zamykasz w metodzie execute wątku a przy tworzeniu wątku przekazujesz to od czego zależy dla jakiego języka jest generowany plik. Klasę wątku tworzysz JEDNĄ! a jedynie jej instancji tyle ile potrzebujesz plików wygenerować.
Pokaż pętlę to będzie można coś konkretniej powiedzieć

OK, rozumiem. Dla jednego wątku. Co jak jest ich więcej?
Jak pisałem, mogę nie wiedzieć o czym piszę, dlatego wklejam pseudo-kod pętli...
Pętla jak pętla, nie wiem co pomoże tutaj:

Info: Z pliku odczytuje nazwy języków, dla których mam utworzyć pliki\katalogi. Sprawdzam, czy mam je użyć i czy są "oficjalne". Nieważne co to znaczy.
I w każdej iteracji odpalam funkcje, której zapodaje dane (Katalog docelowy, Kod języka i parę innych). AInstallDir jest parametrem przekazanym wcześniej.

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;

Proszę o pokazanie przykładowego kodu z tworzeniem klasy wątku i potomnych.

-Pawel

@Pepe:

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;

pisane z głowy .....

@grzegorz_so: Dziękuję!
Wygląda na to, że to jest bardzo proste. Sprawdzę ten kod.
Wygląda obiecująco i wydaje się, że jest zapisem sugestii @abrakadaber
-Pawel

@Pepe:
w twoim przypadku główna pętla

  while not (Application.Terminated) or (Terminated) do 

w kodzie metody exceute jest zbędna ponieważ kod metody ma się wykonać tylko raz

@grzegorz_so: Tak, jeszcze się zastanawiam nad jednym aspektem. Wątek główny musi wiedzieć kiedy zakończyć działanie.
Pasowałoby jakoś poinformować, że wszystkie wątki poboczne zakończyły działanie... muszę nad tym pomyśleć jeszcze.

@Pepe:
Jakiej wersji Delphi używasz ?
W nowszych delphi jest klasa TInterlocked w module System.SyncObjs.TInterlocked której można użyć do tego celu

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;

@grzegorz_so: Twój kod po dopasowaniu działa.
Dziękuję Ci. Na testowych plikach utworzenie 7 katalogów z plikami zajmowało 3.5s - przy zastosowaniu wątków - 0.5s.
Zatem, zgodnie z oczekiwaniami jest duży progres. Poczytam jeszcze o tym cudzie TInterLocked i ogólnie o wątkach, bo jak widać warto.
Wiem, że u mnie to jest trywialne zastosowanie, bo nie muszę synchronizować danych z GUI lub innymi wątkami, ale wydaje się działać.

Edit: Żeby nie było za łatwo. Część plików nie została utworzona (zatem czas się nieco wydłuży), pewnie jakaś kolizja po drodze, bo to w sumie testowe środowisko. Ale myślę, że to uporządkuje i będzie śmigać.

Wszystko ładnie działa. W aplikacji wielowątkowej uzyskałem 4.5s (normalnie 12s). Ale teraz łyżka dziegciu. Co z tego, że człowiek się stara, chce zminimalizować czas wykonania - skoro program antywirusowy WYDŁUŻA ten czas (nawet do 25s!). Teraz nie wiem, czy poświęcony czas na przepisanie aplikacji miał sens, bo tak czy siak, AV na komputerze użytkownika końcowego może skanować każdą operację i w efekcie zniwelować cały uzysk... eh :(

@grzegorz_so:
Pozwolę sobie przywołać ten wątek (nomen omen)...

Jak zmodyfikować ten kod, żeby móc użyć metody Synchronize?
Chciałbym pokazać postęp przy użyciu TProgressBar (np. 5 wątków, to co zakończony wątek, ustawiamy ProgressBar.Position na 20% więcej).

Mógłbyś podać prosty przykład wykorzystania Synchrnize (dostęp do wątka głównego) z ProgressBar?
Dzięki,
-Pawel

Przygotowałem prosty przykład o co mi chodzi. Thread Test.zip

Aplikacja ma pobrać dane w wielu wątkach (w dynamicznie tworzonej formie), wyświetlić postęp oraz opis danej akcji i pokazać główne okno.
Mam taki problem, że nie wiem jak wyświetlić Postęp (opis danej akcji oraz pasek postępu ProgressBar dla danej akcji).

Nie wiem jak zastosować metodę Synchronize (jak ją dodam to aplikacja zwiesza się (czeka na lepszą Polskę :P)... Z pewnością coś robię źle.
Poza tym, nie wiem jak przekazać informację w Synchronize, która akcja jest wykonywana, żeby pokazać odpowiedni tekst informacyjny.
Mam nadzieję, że opisałem to dobrze.

Bardzo proszę o wskazówki jak to zrobić.
Szczególnie Ciebie @grzegorz_so, bo Ty pokazałeś mi jak odpalić kilka wątków na raz...

-Pawel

@Pepe:
w metodzie

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

po odpaleniu wszystkich wątków program w pętli czekał na ich zakończenie co wstrzymywało przetwarzanie komunikatów i tym samym blokowało wykonanie metody Synchronize z wątków pobocznych.
Wątek główny czekał na zakończenie wątków pobocznych, a wątki poboczne czekały na wykonanie Synchronize, dochodziło do zakleszczenia i zwiechy aplikacji

Sprawdzenie czy wątki są zakończone podpiąłem pod Timera na formie

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.

BTW.
Nazwy metod pisane w całości dużymi literami kłują w oczy.
Ten sposób nazewnictwa stosuje się najczęściej do nazw stałych (const) i tym samym jest to mocno mylące

Dzięki. Analizuję... Testuję... Przystosowuję...
Być może będę miał uwagi.
-Pawel

Muszę opracować metodę zamknięcia formy Postępu -> Teraz robi to Timer (nie wiem czy Timer to dobre rozwiązanie).

Możesz zrobić to z wątku pobocznego, callbackiem albo wprost zamykając formę z wątku.

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;

Dodał bym że operowanie na formie podpiętej pod zmienną globalną nie jest dobrym rozwiązaniem
ponieważ w kodzie wątku odwołujesz się do jednej globalnej instancji formy ProgressBar

Czy jest możliwość odczekania powiedzmy 1s prze zamknięciem formy (ja to nie robię poprzez ProgressFrm.close a poprzez ProgressFrm.ModalResult := mrOK;).
Chciałbym tuż przed zamknięciem formy z wątkami, po ich zakończeniu wyświetlić tekst, w stylu - Hurra, udało się! Możesz używać aplikacji :P.

Niestety, to nie działa:

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;

Te Sleep tutaj blokuje formę (czeka te 1s, ale nie odświeża labela i progressa...

@Pepe:
nieco zmieniony kod, z callbackiem do zamknięcia formy Progress, bez zmiennej globalnej ProgressFrm

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.

oraz utworzenie formy z formy głównej

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;

To jest koszmarek, odwołując się do elementów klasy(formy) wiążesz kod metody ze zmienną globalną.
Jeśli tak ma być tylko w kodzie testowym to jest słabe wyjaśnienie.
Ale ja w nawet w kodzie testowym posłużył bym się poniższym kodem

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

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

@Pepe:
patrz powyżej, możesz to zrobić w kodzie metody kod metody TProgressFrm.onThreadClose(sender: tobject)

Te Sleep tutaj blokuje formę (czeka te 1s, ale nie odświeża labela i progressa...

w moim kodzie wątek tylko powiadamia formę o swoim zakończeniu

Tak, analizuję!
Wstawiasz kod szybciej, niż ja go kopiuję :P
Dziękuję ci za czas i pomoc!
-Pawel

@Pepe:

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;

po zakończeniu wszystkich wątków przez 3 sekundy label informuje o ich zamknięciu po czym forma się zamyka

To działa, ale czas Sleep(3000) nie jest 3 sekundami...

Poza tym:

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

@Pepe:
sleep(3000) to 3 tys. milisekund = 3 sekundy
nie wiem skąd masz błąd kompilacji, wklejałem działający kod

Przeniosłem do Public i jest gitara.... Ale czas zamknięcia jest nieprawidłowy. Za długi
czas trzy sekundy jest liczony od momentu zakończenia ostatniego wątku

spakuj i podaj cały kod projektu

@Pepe:
Komentarze służą do pobocznych od tematu postu wymiany zdań.
Pisz w postach.

chodzi o to, że wpisując taką wartość, program czeka np. 6s, albo 10s.

odpaliłem Twój projekt i nie widzę żadnej czasowej zwłoki przy zamykaniu formy

@Pepe:
w metodzie

TMyMultiThread.SYNCHRONIZE_AVAILABLE_DATA();

zupełnie niepotrzebnie w każdym przypadku case wstawiasz kod sprawdzający if assigned(self.LBL) then

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;

można to zrobić raz

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;

tym samym kod metody skraca się trzykrotnie

Film pokazujący problem Sleep i zamykaniem: https://www.dropbox.com/s/c36frmu2npr3wje/TEST.mp4?dl=1
Nie trzeba się logować na swój dropbox, można obejrzeć niezalogowany...

@Pepe:
spróbuj tak

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;

u mnie zamyka się w czasie ok 3 sek.

Działa prawidłowo. Dziękuję.
Na dzisiaj mam dość. Wspaniała robota!