Lazarus 多线程例子源码 Example DEMO

猫工

2. Type
3.     TMyThread = class(TThread)
4.     private
5.       fStatusText : string;
6.       procedure ShowStatus;
7.     protected
8.       procedure Execute; override;
9.     public
10.       Constructor Create(CreateSuspended : boolean);
11.     end;
13.   constructor TMyThread.Create(CreateSuspended : boolean);
14.   begin
15.     FreeOnTerminate := True;
16.     inherited Create(CreateSuspended);
17.   end;
19.   procedure TMyThread.ShowStatus;
20.   // this method is executed by the mainthread and can therefore access all GUI elements.
21.   begin
22.     Form1.Caption := fStatusText;
23.   end;
25.   procedure TMyThread.Execute;
26.   var
27.     newStatus : string;
28.   begin
29.     fStatusText := 'TMyThread Starting...';
30.     Synchronize(@Showstatus);
31.     fStatusText := 'TMyThread Running...';
32.     while (not Terminated) and ([any condition required]) do
33.       begin
34.         ...
35.         [here goes the code of the main thread loop]
36.         ...
37.         if NewStatus <> fStatusText then
38.           begin
39.             fStatusText := newStatus;
40.             Synchronize(@Showstatus);
41.           end;
42.       end;
43.   end;
46. var
47.     MyThread : TMyThread;
48.   begin
49.     MyThread := TMyThread.Create(True); // This way it doesn't start automatically
50.     ...
51.     [Here the code initialises anything required before the threads starts executing]
52.     ...
53.     MyThread.Resume;
54.   end;

复制代码

如果您想使您的应用程序更加灵活，您可以创建一个线程的事件，这您的同步方法不会被紧紧与特定形式或类的耦合方式：您可以附加听众线程的事件。下面是一个例子：

2.    Type
3.     TShowStatusEvent = procedure(Status: String) of Object;
5.     TMyThread = class(TThread)
6.     private
7.       fStatusText : string;
8.       FOnShowStatus: TShowStatusEvent;
9.       procedure ShowStatus;
10.     protected
11.       procedure Execute; override;
12.     public
13.       Constructor Create(CreateSuspended : boolean);
14.       property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
15.     end;
17.   constructor TMyThread.Create(CreateSuspended : boolean);
18.   begin
19.     FreeOnTerminate := True;
20.     inherited Create(CreateSuspended);
21.   end;
23.   procedure TMyThread.ShowStatus;
24.   // this method is executed by the mainthread and can therefore access all GUI elements.
25.   begin
26.     if Assigned(FOnShowStatus) then
27.     begin
28.       FOnShowStatus(fStatusText);
29.     end;
30.   end;
32.   procedure TMyThread.Execute;
33.   var
34.     newStatus : string;
35.   begin
36.     fStatusText := 'TMyThread Starting...';
37.     Synchronize(@Showstatus);
38.     fStatusText := 'TMyThread Running...';
39.     while (not Terminated) and ([any condition required]) do
40.       begin
41.         ...
42.         [here goes the code of the main thread loop]
43.         ...
44.         if NewStatus <> fStatusText then
45.           begin
46.             fStatusText := newStatus;
47.             Synchronize(@Showstatus);
48.           end;
49.       end;
50.   end;
52. Type
53.     TForm1 = class(TForm)
54.       Button1: TButton;
55.       Label1: TLabel;
56.       procedure FormCreate(Sender: TObject);
57.       procedure FormDestroy(Sender: TObject);
58.     private
59.       { private declarations }
60.       MyThread: TMyThread;
61.       procedure ShowStatus(Status: string);
62.     public
63.       { public declarations }
64.     end;
66.   procedure TForm1.FormCreate(Sender: TObject);
67.   begin
68.     inherited;
69.     MyThread := TMyThread.Create(true);
70.     MyThread.OnShowStatus := @ShowStatus;
71.   end;
73.   procedure TForm1.FormDestroy(Sender: TObject);
74.   begin
75.     MyThread.Terminate;
76.     MyThread.Free;
77.     inherited;
78.   end;
80.   procedure TForm1.Button1Click(Sender: TObject);
81.   begin
82.    MyThread.Resume;
83.   end;
85.   procedure TForm1.ShowStatus(Status: string);
86.   begin
87.     Label1.Caption := Status;
88.   end;

复制代码

猫工

有一个线程在Windows与潜在头痛，如果您使用-衣原体（堆栈检查）开关。原因不是很清楚堆栈检查将“触发任何TThread.Create如果您使用默认的堆栈大小”。唯一的工作暂时解决办法是根本不使用衣原体开关。请注意，不会导致在主线程例外，但在新创建的。
这个“看起来”像如果线程是从来就没有开始。
一个好的代码来检查这方面和其他例外，可以发生在线程创建是：

2. MyThread:=TThread.Create(False);
3.     if Assigned(MyThread.FatalException) then
4.       raise MyThread.FatalException;

复制代码

此代码将确保任何例外，发生在线程创建将在您的主线程的问题。

书痕

我原先看一个类似手册的东西，上面是用BeginThread函数开启一个线程，总感觉不好用，还是lz这个比较爽一些...