Вопрос по потокам (TThread и lazarus)

[Михаил Крамер]

Возникла необходимость пременить потоки в Linux. Причём не программировал потоки очень давно. Чтобы вспомнить, состряпал примерчик (Привожу только модуль формы):

Код: Выделить всё

unit Unit1;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls;

type
    { TPaintThread1 }
    TPaintThread1 = class (TThread)
    public
        procedure Execute; override;
    end;

  { TForm1 }
  TForm1 = class(TForm)
    Button1: TButton;
    PaintBox1: TPaintBox;
    PaintBox2: TPaintBox;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  private
    { private declarations }
    a : TThread;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{ TPaintThread1 }

procedure TPaintThread1.Execute;
var
    x, y, r: Integer;
begin
    while true do with form1.PaintBox1.Canvas do
    begin
        x:= Random(3 * form1.PaintBox1.Width div 4);
        y:= Random(3 * Form1.PaintBox1.Height div 4);
        r:= random(3 * form1.PaintBox1.Width div 4);
        Brush.Color:= Random($FFFF);
        Pen.Color:= Random($FFFF);
        EllipseC(x, y, r, r);
    end;
end;

{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
  a:= TPaintThread1.Create(false);
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  a.Terminate;
end;

initialization
  {$I unit1.lrs}

end.


Судя по работе никакой многопотоковости нет и в помине, поскольку кнопки формы перестают работать после запуска потока, и завершается программа только командой kill. В чём может быть дело?

[yser]

подозреваю что поток забирает 100% проц. времени.
попробуй в потоке sleep(1) например.

[Mr.Smart]

Возникла необходимость пременить потоки в Linux. Причём не программировал потоки очень давно. Чтобы вспомнить, состряпал примерчик (Привожу только модуль формы):

Код: Выделить всё

unit Unit1;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls;

type
    { TPaintThread1 }
    TPaintThread1 = class (TThread)
    public
        procedure Execute; override;
    end;

  { TForm1 }
  TForm1 = class(TForm)
    Button1: TButton;
    PaintBox1: TPaintBox;
    PaintBox2: TPaintBox;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  private
    { private declarations }
    a : TThread;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{ TPaintThread1 }

procedure TPaintThread1.Execute;
var
    x, y, r: Integer;
begin
    while true do with form1.PaintBox1.Canvas do
    begin
        x:= Random(3 * form1.PaintBox1.Width div 4);
        y:= Random(3 * Form1.PaintBox1.Height div 4);
        r:= random(3 * form1.PaintBox1.Width div 4);
        Brush.Color:= Random($FFFF);
        Pen.Color:= Random($FFFF);
        EllipseC(x, y, r, r);
    end;
end;

{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
  a:= TPaintThread1.Create(false);
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  a.Terminate;
end;

initialization
  {$I unit1.lrs}

end.


Судя по работе никакой многопотоковости нет и в помине, поскольку кнопки формы перестают работать после запуска потока, и завершается программа только командой kill. В чём может быть дело?

А где синхронизация? Где вызовы Synchronize? Возникают "гонки"........

[Bupyc]

yser прав. В цикле надо добавить Sleep(). Хотя его отсутствие не должно приводить к зависанию приложения (по-крайней мере так будет в Windows). Но есть еще один момент. Приведённый код обращается к объектам GUI из потока. Иногда это конечно прокатывает , но вообще так не делается. Для того, что бы обратиться к GUI из потока нужно использовать метод TThread.Synchronize();
Т.е. код должен выглядеть примерно так (за 100% правильность синтаксиса не ручаюсь):

Код: Выделить всё


procedure TPaintThread1.GUICall();
var
    x, y, r: Integer;
begin
  with form1.PaintBox1.Canvas do
begin
        x:= Random(3 * form1.PaintBox1.Width div 4);
        y:= Random(3 * Form1.PaintBox1.Height div 4);
        r:= random(3 * form1.PaintBox1.Width div 4);
        Brush.Color:= Random($FFFF);
        Pen.Color:= Random($FFFF);
        EllipseC(x, y, r, r);
end;
end;

procedure TPaintThread1.Execute;
begin
    while not Terminated do
    begin
     Synchronize(@GUICall);
     Sleep(1);
    end;
end;



[Михаил Крамер]

Благодарю. Обязательно проверю

Добавлено спустя 22 часа 42 минуты 44 секунды:
Изменил код в соответствии с рекомендациям, даже добавил второй поток, рисующий квадратики в PaintBox2. Многопотоковость заработала - квадратики и кружочки рисуются "одновременно".

Но возникла странность с завершением потоков. При попытке завершить потоки вызовами Terminate в обработчике OnClose программа то виснет, то выдаёт различные RunTime Errors (номер 6, системные сигналы и т.п.) Но стоит добавить вторую кнопку и в перенести вызовы Terminate в её OnClick - всё в порядке, и потоки завершаются, и программа после этого закрывается. Я не понимаю разницу...

[anzo]

Для правильного завершения работы потока, нужно устанавливать у него свойство FreeOnTerminate = true или при завершении работы программы
после вызова Terminate в главном потоке вызвать у дочернего потока метод WaitFor, а после уже Free

[EmeraldMan]

Признаться в Линуксе с потоками не работал, а вы не пробовали приоритет поменьше установить?

Код: Выделить всё

Thread.Priority := tpLower;

Так просто "правильнее" будет, чем Sleep использовать.

[Mr.Smart]

Но возникла странность с завершением потоков. При попытке завершить потоки вызовами Terminate в обработчике OnClose программа то виснет, то выдаёт различные RunTime Errors (номер 6, системные сигналы и т.п.) Но стоит добавить вторую кнопку и в перенести вызовы Terminate в её OnClick - всё в порядке, и потоки завершаются, и программа после этого закрывается. Я не понимаю разницу...

Тут дело скорее в том, что форма уничтожилась раньше чем дочерние потоки. И соответственно form1 уже несуществует, а поток пытается к ней обратится!