Windows ではスレッドを使用してアプリケーションを実行すると問題が発生しますが、Linux Ubuntu 12.04 で実行するとアプリがクラッシュします。
スレッドを理解するだけの非常に小さなアプリです。
スレッドが作成されると、アプリがクラッシュします。
コードは次のとおりです。
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ComCtrls;
type
{ TMyThread }
TMyThread = class(TThread)
private
fStatusText: string;
procedure CambiaLabel();
protected
procedure Execute; override;
public
constructor Create(CreateSuspended: boolean);
end;
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
miHilo: TThread;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TMyThread }
procedure TMyThread.CambiaLabel();
begin
Form1.Label1.Caption:=fStatusText;
Form1.ProgressBar1.StepIt;
if Form1.ProgressBar1.Position = Form1.ProgressBar1.Max then begin
Form1.miHilo.Terminate;
Form1.ProgressBar1.Position := 0;
end;
end;
procedure TMyThread.Execute;
var
newStatus : string;
begin
fStatusText := 'TMyThread comenzando...';
fStatusText := 'TMyThread Corriendo ...';
while (not Terminated) and (true {any condition required}) do begin
//here goes the code of the main thread loop
Synchronize(@CambiaLabel);
end;
end;
constructor TMyThread.Create(CreateSuspended: boolean);
begin
FreeOnTerminate := True;
inherited Create(CreateSuspended);
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
if miHilo <> nil then begin
ShowMessage('Ya se esta ejecutando');
end
else begin
miHilo := TMyThread.Create(false);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if miHilo <> nil then begin
miHilo.Terminate;
ShowMessage('Hilo terminado');
miHilo:=nil;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
end;
end.
ここにエラーメッセージの画像があります: error message image
