Dlaczego tworzenie wątków obciąża wątek główny programu?

Może mi ktoś wytłumaczyć dlaczego jak w wątku odpalę procedurę która tworzy 10 wątków to główny wątek programu jest mocno obciążony, ponieważ forma główna programu bardzo się haczy gdy nią poruszam i zamula drastycznie. Tylko ta forma sam windows i inne aplikacji są ok więc to nie jest obciążenie procesora na 100%

Poniżej kod programu w którym wywaliłem wszystko co te watki robiły a program nadal się tnie.

type
  TThreadGetFile = class(TThread)
  private
    fFileName: string;
  public
    constructor Create(AFileName: string);
    destructor Destroy; override;
    property FileName: string read fFileName;
  protected
    procedure Execute; override;
  end;

  TThreadDownloader = class(TThread)
  private
    fIndex: integer;
  public
    constructor Create;
    destructor Destroy; override;
  protected
    procedure Execute; override;
  end;

var
  hsDownloader: THandle;

implementation

{ TTaskDownloader }
constructor TThreadGetFile.Create(AFileName: string);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  fFileName := AFileName;
end;

destructor TThreadGetFile.Destroy;
begin
  ReleaseSemaphore(hsDownloader, 1, nil);
  Inherited;
end;

procedure TThreadGetFile.Execute;
var
  dir: string;
begin
  try
    sleep(100);
  except
    on E: Exception do
    begin
      dir := E.Message;
    end;
  end;
end;

{ TThreadDownloader }
constructor TThreadDownloader.Create;
begin
  inherited Create(False);
  FreeOnTerminate := True;
end;

destructor TThreadDownloader.Destroy;
begin
  Inherited;
end;

procedure TThreadDownloader.Execute;
var
  dir: string;
  CurrentFile: string;
  TotalSize, CurrentTotal: int64;
  ListDownload: TList<string>;
  I: integer;
  HWND: THandle;
  ThreadGetFile: TThreadGetFile;
begin
  HWND := SendMessage(FindWindow('TTasks', 'Tasks'), WM_AddTask, NativeInt(PChar('Wyszukiwanie nowych zdjęć')), 0);
  PostMessage(HWND, WM_SetTaskMarquee, 0, 0);
  Synchronize(SetConnection);
  ListDownload := TList<string>.Create;
  try
   (...fragment który wypełnia ListDownload...)    

    fIndex := 0;
    while fIndex < ListDownload.Count do
    begin
      While WaitForSingleObject(hsDownloader, 200) = WAIT_TIMEOUT do
        sleep(100);
      ThreadGetFile := TThreadGetFile.Create(ListDownload[fIndex]);  //To obciąża 
      ThreadGetFile.Priority := tpIdle;                                                      
      ThreadGetFile.Start;
      inc(fIndex);
    end;
   finally
      ListDownload.Free;
    end;
  end;
end;

initialization

hsDownloader := CreateSemaphore(nil,  10, 10, 'SemaphoreThreadDownloader');

finalization

CloseHandle(hsDownloader);

No to jest kod wątków roboczych a kod głównego wątku?

somedev napisał(a):

No to jest kod wątków roboczych a kod

Główny wątek to bezczynna form z buttonem gdzie tworzony jest jeden wątek tthreadDownloader.create,

Pokaż kod.

Nowa aplikacja z pustą formą i ten sam objaw. Poniżej cały kod możecie odpalić i sprawdzić u siebie.

unit Unit8;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, acProgressBar, Vcl.StdCtrls, Generics.Collections;

type
  TForm8 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  // Return Code
  RC_OK    = 1;
  RC_ERROR = 2;

type
  TThreadGetFile = class(TThread)
  private
    fFileName: string;
    fReturnCode: integer;
    procedure SetConnection;
  public
    constructor Create(AFileName: string);
    destructor Destroy; override;
    property ReturnCode: integer read fReturnCode;
    property FileName: string read fFileName;
  protected
    procedure Execute; override;
  end;

  TThreadDownloader = class(TThread)
  private
    fIndex: integer;
  public
    constructor Create;
    destructor Destroy; override;
  protected
    procedure Execute; override;
  end;

var
  hsDownloader: THandle;
  Form8: TForm8;

implementation

{$R *.dfm}

{ TTaskDownloader }
constructor TThreadGetFile.Create(AFileName: string);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  fFileName := AFileName;
  fReturnCode := 0;
end;

destructor TThreadGetFile.Destroy;
begin
  ReleaseSemaphore(hsDownloader, 1, nil);
  Inherited;
end;

procedure TThreadGetFile.SetConnection;
begin

end;

procedure TThreadGetFile.Execute;
begin
  try
    sleep(1000);
    fReturnCode := RC_OK;
  except
    on E: Exception do
    begin
      fReturnCode := RC_ERROR;
    end;
  end;
end;

{ TThreadDownloader }
constructor TThreadDownloader.Create;
begin
  inherited Create(False);
  FreeOnTerminate := True;
end;

destructor TThreadDownloader.Destroy;
begin
  Inherited;
end;

procedure TThreadDownloader.Execute;
var
  ListDownload: TList<string>;
  I: integer;
  ThreadGetFile: TThreadGetFile;
begin
  ListDownload := TList<string>.Create;
  try
    for I := 0 to 26000 do
    begin
      ListDownload.Add('test');
    end;

    fIndex := 0;
    while fIndex < ListDownload.Count do
    begin
      While WaitForSingleObject(hsDownloader, 200) = WAIT_TIMEOUT do
        sleep(100);

      ThreadGetFile := TThreadGetFile.Create(ListDownload[fIndex]);
      ThreadGetFile.Priority := tpIdle;
      ThreadGetFile.Start;
      //sleep(20);  /Szczelina czasowa w systemie windows 20-40ms
      inc(fIndex);
    end;
  finally
    ListDownload.Free;
  end;
end;


procedure TForm8.Button1Click(Sender: TObject);
var
  T : TThreadDownloader;
begin
  T := TThreadDownloader.create;
end;

initialization

hsDownloader := CreateSemaphore(nil, 20, 20, 'TSemaphoreThreadDownloader');

finalization

CloseHandle(hsDownloader);

end.

Tak z grubsza biorąc, sleep w wątku to nie jest dobra praktyka. Wywal te "opóżniacze", odpal jeden wątek i zobacz co się wtedy dzieje.

Czego się spodziewasz po semaforze? Nie jest tutaj jasne

machinebyte4 napisał(a):

Tak z grubsza biorąc, sleep w wątku to nie jest dobra praktyka. Wywal te "opóżniacze", odpal jeden wątek i zobacz co się wtedy dzieje.

To opóźnienie 1 sekunda jest wstawione tylko po to aby wątek chwile działał. Cały właściwy kod wywaliłem to jest tylko na potrzeby tego przykładu.

AnyKtokolwiek napisał(a):

Czego się spodziewasz po semaforze? Nie jest tutaj jasne

Semafor tutaj nie ma nic do rzeczy. Masz wywalony semafor i objaw jest taki sam:

unit Unit8;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, acProgressBar, Vcl.StdCtrls, Generics.Collections;

type
  TForm8 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  // Return Code
  RC_OK    = 1;
  RC_ERROR = 2;

type
  TThreadGetFile = class(TThread)
  private
    fFileName: string;
    fReturnCode: integer;
    procedure SetConnection;
  public
    constructor Create(AFileName: string);
    destructor Destroy; override;
    property ReturnCode: integer read fReturnCode;
    property FileName: string read fFileName;
  protected
    procedure Execute; override;
  end;

  TThreadDownloader = class(TThread)
  private
    fIndex: integer;
    fExistsThread: integer;
    procedure GiveMeResult(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;
  protected
    procedure Execute; override;
  end;

var
 // hsDownloader: THandle;
  Form8: TForm8;

implementation

{$R *.dfm}

{ TTaskDownloader }
constructor TThreadGetFile.Create(AFileName: string);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  fFileName := AFileName;
  fReturnCode := 0;
end;

destructor TThreadGetFile.Destroy;
begin
 // ReleaseSemaphore(hsDownloader, 1, nil);
  Inherited;
end;

procedure TThreadGetFile.SetConnection;
begin

end;

procedure TThreadGetFile.Execute;
begin
  try
    sleep(1000);
    fReturnCode := RC_OK;
  except
    on E: Exception do
    begin
      fReturnCode := RC_ERROR;
    end;
  end;
end;

{ TThreadDownloader }
constructor TThreadDownloader.Create;
begin
  inherited Create(False);
  FreeOnTerminate := True;
end;

destructor TThreadDownloader.Destroy;
begin
  Inherited;
end;

procedure TThreadDownloader.GiveMeResult(Sender: TObject);
begin
  dec(fExistsThread);
end;

procedure TThreadDownloader.Execute;
var
  ListDownload: TList<string>;
  I: integer;
  ThreadGetFile: TThreadGetFile;
begin
  ListDownload := TList<string>.Create;
  try
    for I := 0 to 26000 do
    begin
      ListDownload.Add('test');
    end;

    fIndex := 0;
    while fIndex < ListDownload.Count do
    begin
      while not (fExistsThread < 20) do
        sleep(100);

      inc(fExistsThread);
//      While WaitForSingleObject(hsDownloader, 200) = WAIT_TIMEOUT do
//        sleep(100);

      ThreadGetFile := TThreadGetFile.Create(ListDownload[fIndex]);
      ThreadGetFile.Priority := tpIdle;
      ThreadGetFile.OnTerminate := GiveMeResult;
      ThreadGetFile.Start;
      //sleep(20);  //Bo wątek żyje kolejkuje co 19ms w windows w 1-Core
      inc(fIndex);
    end;
  finally
    ListDownload.Free;
  end;
end;


procedure TForm8.Button1Click(Sender: TObject);
var
  T : TThreadDownloader;
begin
  T := TThreadDownloader.create;
end;
{
initialization

hsDownloader := CreateSemaphore(nil, 20, 20, 'TSemaphoreThreadDownloader');

finalization

CloseHandle(hsDownloader);
}
end.

Zmieniłem założenie i teraz podczas tworzenia wątku TThreadDownloader w jego konstruktorze tworzone jest np 20 wątków TThreadGetFile które czekają na PulseEvent. I teraz aplikacja działa płynnie a wątki ponownie wykonują swoje działanie. Zamiast pierwszej myśli jaką przyjąłem - każdy wątek pobiera tylko 1 plik kończy działanie i uruchamiany jest kolejny.

Tak czy siak chciałbym wiedzieć dlaczego sam konstruktor wątku zamraża wątek główny. Wiem, że w systemie windows wątki mogą wystartować co 20-40ms bo taka jest szczelina.