Przykład aplikacji wielowątkowej dla Lazarusa pod Linuksem

0

Witam,
Czy mógłby ktoś podać jakiś prosty przykład w Lazarusie użycia Thread np. po kliknięciu na Button1 uruchamia się ProgressBar, który trwa parę sekund.
Próbowałem już kilka przykładów lecz ciągle są jakieś błędy.

Korzystam z systemu Linux.

Z góry dziękuję za pomoc.

2

Kompendium Delphi - Aplikacje wielowątkowe - przejdź na koniec artykułu, pobierz załącznik i rozpakuj; Następnie włącz Lazarusa, wybierz opcję konwersji projektu Delphi - wybierz katalog 8, następnie GoThread i otwórz plik projektu; Na koniec skompiluj i uruchom.

0

Pokaż kod i napisz jakie błędy, bo "wrusz maćko" przyjmuje na "skajpaju", a nie na tym forum :/

0

Zrobiłem tak jak opisałeś:

Kompendium Delphi - Aplikacje wielowątkowe - przejdź na koniec artykułu, pobierz załącznik i rozpakuj; Następnie włącz Lazarusa, wybierz opcję konwersji projektu Delphi - wybierz katalog 8, następnie GoThread i otwórz plik projektu; Na koniec skompiluj i uruchom.

Występuje problem:

  • gdy kliknąłem na przycisk uruchom projekt uruchomił się, lecz gdy klikam na przycisk "Go!":

"Go!" dostaję taki komunikat:
Projekt GoThread raised exception class 'EThread' with message:
Semaphore init failed (possibly too many concurrent threads)
At address 46E9E4

Jak inne przykłady testowałem taki sam problem się pojawiał.

0

Powyższy przykład działa wprawdzie po chwili przestaje działać i są błedy pewnie z powodu Importu z Delphi?:
Trzeba było dodać do pliku: GoThread.lpr w uses:

{$ifdef unix}
  cthreads,
  cmem,
{$endif}

Po chwili działania pojawia się taki komunikat:

Project GoThread raised exception class 'External: SIGABRT'.
In file'../nptl/sysdeps/unix/sysv/linux/raise.c' at line 56
0

Witam, mam następujący problem:

 
procedure TMojWatek.Execute;
begin
   FreeOnTerminate := True;
   fpsystem('xterm');
   fpsystem('xterm');
   //ShowMessage('Koniec');
end;

Po wywołaniu powyższego wątku klikając na Button wykonuje się prawidłowo, natomiast gdy dodam ShowMessage otrzymuję błąd

Project Remastering raised exception class 'External: SIGSEGV'.

At address 7FFFF6BBF314

3

Poczytaj o Synchronize. W podlinkowanym w tym temacie artykule jest to raczej nie za dobrze wytłumaczone. Sprawdź rozdział 3 z tej strony http://www.seti.net/indepth/threads/threads.php a najlepiej całość przeczytaj jeśli chcesz używać wątków w większej ilości.
Do tego konkretnego Przypadku jeśli wiadomość ma się pokazać przy kończeniu wątku możesz wykorzystać zdarzenie OnTerminate.

0

Witam,
Wątki umiem tworzyć, lecz nadal nie umiem sobie poradzić z pewnym problemem.

Gdy wykonują się kolejno instrukcje bash to jest ok. Problem pojawia się kiedy chcę aby po wykonaniu instrukcji pojawił się ShowMessage z informacją - wtedy dostaję błąd - przykład poniżej. Problem również występuję gdy chcę aby informacja pojawiła się w Label1.

 
unit Unit1;

{$mode objfpc}{$H+}
{$define UseCThreads}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Unix;

type
  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
  { Watek1 }
     Watek1 = class(TThread)
 protected
   procedure Execute; override;
 end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  Instrukcja1 : Watek1;
begin
  Instrukcja1 := Watek1.Create(False);
end;

procedure Watek1.Execute;
begin
  fpsystem('echo "Instrukcja 1" > instrukcja1.txt');
  //ShowMessage('Plik 1 został utworzony'); // Gdy jest aktywne pojawia się błąd
  fpsystem('echo "Instrukcja 2" > instrukcja2.txt');
  //ShowMessage('Plik 2 został utworzony'); // Gdy jest aktywne pojawia się błąd
end;

end.

Proszę o podanie konkretnego rozwiązania.

1

Pod Lazarusem możesz użyć ShowMessage wyłacznie w ramach głównego wątku, użyj Synchronize().
Poza tym może zajrzyj do manuala Lazarusa http://wiki.freepascal.org/Multithreaded_Application_Tutorial/pl

1

Masz tu gotowca, oczywiście jeśli nie przeczytasz do czego jest to Synchronize to za chwile przyjdziesz tu z bardzo podobnym problemem.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

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

  TWatek1 = class(TThread)
  private
    FFileIndex: integer;

    procedure FSyncShowMessage;
  protected
    procedure Execute; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Instrukcja1 : TWatek1;
begin
  Instrukcja1 := TWatek1.Create(False);
end;

{ TWatek1 }

procedure TWatek1.Execute;
begin
  FreeOnTerminate := True;

//  fpsystem('echo "Instrukcja 1" > instrukcja1.txt');
  FFileIndex := 1;
  Synchronize(FSyncShowMessage);
//  fpsystem('echo "Instrukcja 2" > instrukcja2.txt');
  FFileIndex := 2;
  Synchronize(FSyncShowMessage);  
end;

procedure TWatek1.FSyncShowMessage;
begin
  ShowMessage('Plik '+IntToStr(FFileIndex)+' został utworzony');
end;

end.
0

Poradziłem już sobie z tym wcześniej, ale dziękuję za gotowy przykład. Dla Lazarusa i systemu Linux są wymagane pewne zmiany:

 
{$mode objfpc}{$H+}
{$define UseCThreads}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Unix;

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

  TWatek1 = class(TThread)
  private
    FFileIndex: integer;

    procedure FSyncShowMessage;
  protected
    procedure Execute; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Instrukcja1 : TWatek1;
begin
  Instrukcja1 := TWatek1.Create(False);
end;

{ TWatek1 }

procedure TWatek1.Execute;
begin
  FreeOnTerminate := True;

  fpsystem('echo "Instrukcja 1" > instrukcja1.txt');
  FFileIndex := 1;
  Synchronize(@FSyncShowMessage);
  fpsystem('echo "Instrukcja 2" > instrukcja2.txt');
  FFileIndex := 2;
  Synchronize(@FSyncShowMessage);
end;

procedure TWatek1.FSyncShowMessage;
begin
  ShowMessage('Plik '+IntToStr(FFileIndex)+' został utworzony');
end;

end.

Poniżej przykład dla wyświetlania w Label1 informacji po wykonaniu instrukcji:

 
unit Unit1;

{$mode objfpc}{$H+}
{$define UseCThreads}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Unix;

type
  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
  { Watek1 }
     Watek1 = class(TThread)
   private
     fStatusText : string;
     procedure ShowStatus;
 protected
   procedure Execute; override;
 end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  Instrukcja1 : Watek1;
begin
  Instrukcja1 := Watek1.Create(False);
end;


procedure Watek1.ShowStatus;
begin
  Form1.Label1.Caption := fStatusText;
end;

procedure Watek1.Execute;
begin
   fpsystem('xterm');
   //
   fStatusText := 'Instrukcja 1 zakończona';
   Synchronize(@Showstatus);
   //
   fpsystem('xterm');
   //
   fStatusText := 'Instrukcja 2 zakończona';
   Synchronize(@Showstatus);
end;

end.

Temat uważam za zamknięty. Dziękuję wszystkim za poświęcony czas :)

1 użytkowników online, w tym zalogowanych: 0, gości: 1