DELPHI 多線程（TThread類的實現）

本文轉載自查看原文 2016-08-29 18:49 20318 多線程/ DELPHI

DELPHI 多線程（TThread類的實現）

之前學習了用API實現，讓我們再學習下用DELPHI的TThread類。

先新建一個普通的工程，再新建一個線程類File>>New>>Othre>>Delphi File>Thread Object，取個名字，DELPHI會自動生成一個單元，我們只需往里簡單添加功能代碼，和在要使用的單元里實例引用即可。

為了節省篇幅，現把TMyThread類集成主窗體單元里，在窗體單元里聲明類也是可以的。

例：用工作線程在窗體輸出0~500000的數字。

 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;

CriticalSection(臨界區)

uses SyncObjs;用TCriticalSection類的方法處理。

例：用三個線程，按順序給ListBox添加0~99.

 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.

Mutex (互斥對象)

uses SyncObjs;用TMutex類的方法處理(把釋放語句放在循環內外可以決定執行順序)

例：互斥輸出三個0~2000的數字到窗體在不同位置。

 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 2000  do
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.

Semaphore(信號或叫信號量)

{DELPHI2007不支持信號量，DELPHI2009才開始支持}

 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.

Event (事件對象)

注：相比API的處理方式，此類沒有啟動步進一次后暫停的方法。

  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.

總結：

多線程用TThread類以及Uses syncobjs后使用的 TCriticalSection (臨界區)，TMutex(互斥體)，TSemaphore (信號對象，D2009才開始有)，TEvent (事件對象)很多都是引用了API的方法進行了一定的簡化，不過也有部分功能的缺失，如Event (事件對象)缺少了啟動步進一次后暫停的功能，不過基本在同步上已經夠用了，另外在TThread類聲明的Execute過程里，加上FreeOnTerminate := True;這句會讓線程執行完后自動釋放，還可以把功能代碼的方法套在Synchronize()里，用於同步一些非線程安全的控件對象，避免多個線程同時對一個對象操作引發的問題。

免責聲明！

本站轉載的文章為個人學習借鑒使用，本站對版權不負任何法律責任。如果侵犯了您的隱私權益，請聯系本站郵箱yoyou2525@163.com刪除。

猜您在找 DELPHI 多線程（TThread類的實現）實例 DELPHI 多線程（TThread類的實現）學習筆記： Delphi之線程類TThread Delphi中的線程類 - TThread詳解 DELPHI 多線程（API實現） delphi 對TThread擴充TSimpleThread Delphi多線程詳解 delphi 多線程編程 Delphi 多線程的操作 Delphi的TThread中的FreeOnTerminate成員