首页 › Delphi/Pascal论坛 › DELPHI 多线程（TThread类的实现）

安蝶戒 發表於 2019-9-29 17:57:00

DELPHI 多线程（TThread类的实现）

<p>之前学习了用API实现，让我们再学习下用DELPHI的TThread类。</p>
<p>先新建一个普通的工程，再新建一个线程类File&gt;&gt;New&gt;&gt;Othre&gt;&gt;Delphi File&gt;Thread Object，取个名字，DELPHI会自动生成一个单元，我们只需往里简单添加功能代码，和在要使用的单元里实例引用即可。</p>
<p>为了节省篇幅，现把TMyThread类集成主窗体单元里，在窗体单元里声明类也是可以的。</p>
<p>例：用工作线程在窗体输出0~500000的数字。</p>
<div class="cnblogs_code">
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://common.cnblogs.com/images/copycode.gif"></span></div>
<pre> 1 unit Unit1;
2
3 interface
4
5 uses
6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7   Dialogs, StdCtrls;
8
9 type
10   TMyThread = class(TThread)
11   private
12   { Private declarations }
13   protected
14   procedure Execute; override; {执行}
15   procedure Run; {声明多一个过程，把功能代码写在这里再给Execute调用}
16   end;
17   TForm1 = class(TForm)
18   btn1: TButton;
19   procedure btn1Click(Sender: TObject);
20   private
21   { Private declarations }
22   public
23   { Public declarations }
24   end;
25
26
27
28 var
29   Form1: TForm1;
30
31
32 implementation
33
34 {$R *.dfm}
35
36 var
37   MyThread:TMyThread; {声明一个线程类对象]
38
39 procedure TMyThread.Execute;
40 begin
41   { Place thread code here }
42   FreeOnTerminate:=True; {加上这句线程用完了会自动注释}
43   Run;
44 end;
45
46 procedure TMyThread.Run;
47 var
48   i:integer;
49 begin
50   for i := 0 to 500000 do
51   begin
52   Form1.Canvas.Lock;
53   Form1.Canvas.TextOut(10,10,IntToStr(i));
54   Form1.Canvas.Unlock;
55   end;
56 end;
57
58 procedure TForm1.btn1Click(Sender: TObject);
59 begin
60   MyThread:=TMyThread.Create(False); {实例化这个类，为False时立即运行，为True时可加MyThread.Resume用来启动}
61 end;</pre>
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://common.cnblogs.com/images/copycode.gif"></span></div>
</div>
<p>&nbsp;</p>
<p><strong>CriticalSection(临界区)</strong></p>
<p>&nbsp;uses&nbsp;SyncObjs;用TCriticalSection类的方法处理。</p>
<p>例：用三个线程，按顺序给ListBox添加0~99.</p>
<div class="cnblogs_code">
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://common.cnblogs.com/images/copycode.gif"></span></div>
<pre> 1 unit Unit1;
2
3 interface
4
5 uses
6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7   Dialogs, StdCtrls;
8
9 type
10   TMyThread = class(TThread)
11   private
12   { Private declarations }
13   protected
14   procedure Execute; override; {执行}
15   procedure Run;{运行}
16   end;
17   TForm1 = class(TForm)
18   btn1: TButton;
19   lst1: TListBox;
20   procedure btn1Click(Sender: TObject);
21   procedure FormDestroy(Sender: TObject);
22   private
23   { Private declarations }
24   public
25   { Public declarations }
26   end;
27
28
29
30 var
31   Form1: TForm1;
32
33
34 implementation
35
36 {$R *.dfm}
37
38 uses SyncObjs;
39
40 var
41   MyThread:TMyThread;   {声明线程}
42   CS:TCriticalSection; {声明临界}
43
44
45 procedure TMyThread.Execute;
46 begin
47   { Place thread code here }
48   FreeOnTerminate:=True; {加上这句线程用完了会自动注释}
49   Run;   {运行}
50 end;
51
52 procedure TMyThread.Run;
53 var
54   i:integer;
55 begin
56   CS.Enter;{我要用了，其它人等下}
57   for i := 0 to 100 - 1 do
58   begin
59   Form1.lst1.Items.Add(IntToStr(i));
60   end;
61   CS.Leave;{我用完了，下一个}
62 end;
63
64 procedure TForm1.btn1Click(Sender: TObject);
65 begin
66   CS:=TCriticalSection.Create;   {实例化临界}
67   MyThread:=TMyThread.Create(False); {实例化这个类，为False时立即运行，为True时可加MyThread.Resume用来启动}
68   MyThread:=TMyThread.Create(False);
69   MyThread:=TMyThread.Create(False);
70 end;
71
72
73 procedure TForm1.FormDestroy(Sender: TObject);
74 begin
75   CS.Free;{释放临界体}
76 end;
77
78 end.</pre>
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://common.cnblogs.com/images/copycode.gif"></span></div>
</div>
<p>&nbsp;</p>
<p><strong>Mutex (互斥对象)</strong></p>
<p>uses&nbsp;SyncObjs;用TMutex类的方法处理(把释放语句放在循环内外可以决定执行顺序)</p>
<p>例：互斥输出三个0~2000的数字到窗体在不同位置。</p>
<div class="cnblogs_code">
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://common.cnblogs.com/images/copycode.gif"></span></div>
<pre> 1 unit Unit1;
2
3 interface
4
5 uses
6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7   Dialogs, StdCtrls;
8
9 type
10   TMyThread = class(TThread)
11   private
12   { Private declarations }
13   protected
14   procedure Execute; override; {执行}
15   procedure Run;{运行}
16   end;
17   TForm1 = class(TForm)
18   btn1: TButton;
19   procedure FormDestroy(Sender: TObject);
20   procedure btn1Click(Sender: TObject);
21   private
22   { Private declarations }
23   public
24   { Public declarations }
25   end;
26
27
28
29 var
30   Form1: TForm1;
31
32
33 implementation
34
35 {$R *.dfm}
36
37 uses SyncObjs;
38
39 var
40   MyThread:TMyThread;   {声明线程}
41   Mutex:TMutex; {声明互斥体}
42   f:integer;
43
44
45 procedure TMyThread.Execute;
46 begin
47   { Place thread code here }
48   FreeOnTerminate:=True; {加上这句线程用完了会自动注释}
49   Run;   {运行}
50 end;
51
52 procedure TMyThread.Run;
53 var
54   i,y:integer;
55 begin
56   Inc(f);
57   y:=20*f;
58   for i := 0 to 2000do
59   begin
60   if Mutex.WaitFor(INFINITE)=wrSignaled then   {判断函数，能用时就用}
61   begin
62       Form1.Canvas.Lock;
63       Form1.Canvas.TextOut(10,y,IntToStr(i));
64       Form1.Canvas.Unlock;
65       Sleep(1);
66       Mutex.Release; {释放，谁来接下去用}
67   end;
68   end;
69 end;
70
71 procedure TForm1.btn1Click(Sender: TObject);
72 begin
73   f:=0;
74   Repaint;
75   Mutex:=TMutex.Create(False);{参数为是否让创建者拥有该互斥体，一般为False}
76   MyThread:=TMyThread.Create(False);
77   MyThread:=TMyThread.Create(False);
78   MyThread:=TMyThread.Create(False);
79 end;
80
81 procedure TForm1.FormDestroy(Sender: TObject);
82 begin
83   Mutex.Free;{释放互斥体}
84 end;
85
86 end.</pre>
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://common.cnblogs.com/images/copycode.gif"></span></div>
</div>
<p>&nbsp;</p>
<p><strong>Semaphore(信号或叫信号量)</strong></p>
<p>&nbsp;{DELPHI2007不支持信号量，DELPHI2009才开始支持}</p>
<div class="cnblogs_code">
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://common.cnblogs.com/images/copycode.gif"></span></div>
<pre> 1 unit Unit1;
2
3 interface
4
5 uses
6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7   Dialogs, StdCtrls;
8
9 type
10   TForm1 = class(TForm)
11   Button1: TButton;
12   Edit1: TEdit;
13   procedure Button1Click(Sender: TObject);
14   procedure FormCreate(Sender: TObject);
15   procedure FormDestroy(Sender: TObject);
16   procedure Edit1KeyPress(Sender: TObject; var Key: Char);
17   end;
18
19 var
20   Form1: TForm1;
21
22 implementation
23
24 {$R *.dfm}
25
26 uses SyncObjs;
27 var
28   f: Integer;
29   MySemaphore: TSemaphore;
30
31 function MyThreadFun(p: Pointer): DWORD; stdcall;
32 var
33   i,y: Integer;
34 begin
35   Inc(f);
36   y := 20 * f;
37   if MySemaphore.WaitFor(INFINITE) = wrSignaled then
38   begin
39   for i := 0 to 1000 do
40   begin
41       Form1.Canvas.Lock;
42       Form1.Canvas.TextOut(20, y, IntToStr(i));
43       Form1.Canvas.Unlock;
44       Sleep(1);
45   end;
46   end;
47   MySemaphore.Release;
48   Result := 0;
49 end;
50
51 procedure TForm1.Button1Click(Sender: TObject);
52 var
53   ThreadID: DWORD;
54 begin
55   if Assigned(MySemaphore) then MySemaphore.Free;
56   MySemaphore := TSemaphore.Create(nil, StrToInt(Edit1.Text), 5, ''); {创建，参数一为安全默认为nil，参数2可以填写运行多少线程，参数3是运行总数，参数4可命名用于多进程}
57
58   Self.Repaint;
59   f := 0;
60   CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
61   CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
62   CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
63   CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
64   CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
65 end;
66
67 {让 Edit 只接受 1 2 3 4 5 五个数}
68 procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
69 begin
70   if not CharInSet(Key, ['1'..'5']) then Key := #0;
71 end;
72
73 procedure TForm1.FormCreate(Sender: TObject);
74 begin
75   Edit1.Text := '1';
76 end;
77
78 procedure TForm1.FormDestroy(Sender: TObject);
79 begin
80   if Assigned(MySemaphore) then MySemaphore.Free;
81 end;
82
83 end.</pre>
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://common.cnblogs.com/images/copycode.gif"></span></div>
</div>
<p>&nbsp;</p>
<p>&nbsp;</p>
<p><strong>&nbsp;Event (事件对象)</strong></p>
<p>注：相比API的处理方式，此类没有启动步进一次后暂停的方法。</p>
<div class="cnblogs_code">
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://common.cnblogs.com/images/copycode.gif"></span></div>
<pre>1 unit Unit1;
2
3 interface
4
5 uses
6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7   Dialogs, StdCtrls;
8
9 type
10   TMyThread = class(TThread)
11   private
12   { Private declarations }
13   protected
14   procedure Execute; override;
15   procedure Run;
16   end;
17
18   TForm1 = class(TForm)
19   btn1: TButton;
20   btn2: TButton;
21   btn3: TButton;
22   btn4: TButton;
23   procedure btn1Click(Sender: TObject);
24   procedure FormDestroy(Sender: TObject);
25   procedure btn2Click(Sender: TObject);
26   procedure btn3Click(Sender: TObject);
27   procedure btn4Click(Sender: TObject);
28   procedure FormCreate(Sender: TObject);
29   private
30   { Private declarations }
31   public
32   { Public declarations }
33   end;
34
35 var
36   Form1: TForm1;
37
38 implementation
39
40 {$R *.dfm}
41
42 uses SyncObjs;
43
44 var
45   f:integer;
46   MyEvent:TEvent;
47   MyThread:TMyThread;
48
49 { TMyThread }
50
51
52 procedure TMyThread.Execute;
53 begin
54   inherited;
55   FreeOnTerminate:=True; {线程使用完自己注销}
56   Run;
57 end;
58
59 procedure TMyThread.Run;
60 var
61   i,y:integer;
62 begin
63   Inc(f);
64   y:=20*f;
65
66   for i := 0 to 20000 do
67   begin
68   if MyEvent.WaitFor(INFINITE)=wrSignaled then    {判断事件在用没，配合事件的启动和暂停，对事件相关线程起统一控制}
69   begin
70       Form1.Canvas.lock;
71       Form1.Canvas.TextOut(10,y,IntToStr(i));
72       Form1.Canvas.Unlock;
73       Sleep(1);
74   end;
75
76   end;
77
78 end;
79
80 procedure TForm1.btn1Click(Sender: TObject);
81 begin
82   Repaint;
83   f:=0;
84   if Assigned(MyEvent) then MyEvent.Free;    {如果有，就先销毁}
85
86   {参数1安全设置，一般为空；参数2为True时可手动控制暂停，为Flase时对象控制一次后立即暂停
87   参数3为True时对象建立后即可运行，为false时对象建立后控制为暂停状态，参数4为对象名称，用于跨进程，不用时默认''}
88   MyEvent:=TEvent.Create(nil,True,True,'');   {创建事件}
89
90 end;
91
92 procedure TForm1.btn2Click(Sender: TObject);
93 var
94   ID:DWORD;
95 begin
96   MyThread:=TMyThread.Create(False);      {创建线程}
97 end;
98
99 procedure TForm1.btn3Click(Sender: TObject);
100 begin
101   MyEvent.SetEvent;    {启动}{事件类没有PulseEvent启动一次后轻描谈写}
102 end;
103
104 procedure TForm1.btn4Click(Sender: TObject);
105 begin
106   MyEvent.ResetEvent;{暂停}
107 end;
108
109 procedure TForm1.FormCreate(Sender: TObject);
110 begin
111    btn1.Caption:='创建事件';
112    btn2.Caption:='创建线程';
113    btn3.Caption:='启动';
114    btn4.Caption:='暂停';
115 end;
116
117 procedure TForm1.FormDestroy(Sender: TObject);
118 begin
119   MyEvent.Free;      {释放}
120 end;
121
122 end.</pre>
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://common.cnblogs.com/images/copycode.gif"></span></div>
</div>
<p><strong>总结：</strong></p>
<p>多线程用TThread类以及Uses syncobjs后使用的&nbsp;TCriticalSection (临界区)，TMutex(互斥体)，TSemaphore (信号对象，D2009才开始有)，TEvent (事件对象)很多都是引用了API的方法进行了一定的简化，不过也有部分功能的缺失，如Event (事件对象)缺少了启动步进一次后暂停的功能，不过基本在同步上已经够用了，另外在TThread类声明的Execute过程里，加上FreeOnTerminate := True;这句会让线程执行完后自动释放，还可以把功能代码的方法套在Synchronize()里，用于同步一些非线程安全的控件对象，避免多个线程同时对一个对象操作引发的问题。</p><br><br>
来源：https://www.cnblogs.com/linjincheng/p/11609218.html

查看完整版本: DELPHI 多线程（TThread类的实现）