第四節：多線程類的改進
1.需要改進的地方
a) 讓線程類結束時不自動釋放，以便符合 delphi 的用法。即 FreeOnTerminate:=false;
b) 改造 Create 的參數，讓它適合訪問 COM 組件。如：在線程時空中能夠創建 TAdoConnection;
c) 設計一個接口能將一個過程( procedure )塞到線程時空中去運行的功能，這樣，不必每次重載 Execute 函數。
d) 設計一個輸出信息的接口
unit
uFooThread;
interface
uses
System
.
Classes, System
.
SyncObjs;
type
TOnMsg =
procedure
(AMsg:
string
)
of
object
;
// 定義一個用於輸出信息的事件
// 很多編程資料推薦在 String 參數前面加 const ，以提高效率
// 我的理由是為了代碼美觀。如果有多個參數，加上 const 參數太長了。
// 在以后的使用中，請自己斟酌是否加 const 。
TFooThread =
class
(TThread)
private
FEvent: TEvent;
FCanAccessCom:
Boolean
;
FRunningInThread: TThreadMethod;
// TThreadMethod 的定義是 TThreadMethod = Procedure of object;
// 意為這個 Procedure 是寫在一個類中的。
// 在其它編程語言中，TThreadMethod 被稱為函數指針。
// FRunningInThread 它用來保存將要在線程中運行的代碼或 Procedure
procedure
DoExecute;
protected
// protected 段中定義的變量與函數，允許在子類中調用。
procedure
Execute; override;
procedure
DoOnStatusMsg(AMsg:
string
);
procedure
ExecProcInThread(AProc: TThreadMethod);
public
constructor
Create(ACanAccessCOM:
Boolean
); reintroduce;
// reintroduce 是再引入 Create 的參數的意思。
destructor
Destroy; override;
procedure
StartThread; virtual;
public
OnStatusMsg: TOnMsg;
// 亦可改寫為 Property OnStatusMsg:TOnMsg Read FOnMsg write SetOnMsg;
// 太啰嗦了，如果不再對 SetOnMsg 進行操作，建議這樣寫。
// 如果后期需要改動，原來的代碼亦可以不變。
end
;
// 未說明之處，請參考面向對象設計基礎知識。
implementation
uses
ActiveX, SysUtils;
constructor
TFooThread
.
Create(ACanAccessCOM:
Boolean
);
begin
inherited
Create(
false
);
FEvent := TEvent
.
Create(
nil
,
true
,
false
,
''
);
FreeOnTerminate :=
false
;
end
;
destructor
TFooThread
.
Destroy;
begin
// 此處我們要設計手動 Free 的調用。
Terminate;
// 首先要將 Terminated 設置為 true;
FEvent
.
SetEvent;
// 啟動線程。
WaitFor;
// 此 waitfor 的意思是等待線程退出 Execute
// 此 WaitFor 是 TThread 類的。注意與 FEvent.WaitFor 區別
// 本質上，它們都是操作系統提供的信號的等待功能。
// 有興趣可以直接參考系統源碼 ( delphi 提供的源碼 )
FEvent
.
Free;
inherited
;
end
;
procedure
TFooThread
.
DoExecute;
begin
FEvent
.
WaitFor;
FEvent
.
ResetEvent;
while
not
Terminated
do
begin
try
FRunningInThread;
// 因為它是一個 Procedure ，故可直接運行。
except
// 捕捉異常，否則異常發生時代碼將退出 Execute ，線程生命周期就結束了。
on
e: Exception
do
begin
DoOnStatusMsg(
'ThreadErr:'
+ e
.
Message);
end
;
end
;
FEvent
.
WaitFor;
FEvent
.
ResetEvent;
end
;
end
;
procedure
TFooThread
.
DoOnStatusMsg(AMsg:
string
);
begin
// 這是引發事件常用的寫法。
if
Assigned(OnStatusMsg)
then
OnStatusMsg(AMsg);
end
;
procedure
TFooThread
.
ExecProcInThread(AProc: TThreadMethod);
begin
FRunningInThread := AProc;
FEvent
.
SetEvent;
// 啟動線程。
// 需要說明的是，第一次運行本函數 ExecProcInThread 一般是在主線程時空里運行。
// 第二次運行本函數可以設計為在線程時空中運行，后面章節會講到。
// 其作用是把 AProc 塞到線程時空中並啟動線程。end
;
procedure
TFooThread
.
Execute;
begin
if
FCanAccessCom
then
begin
CoInitialize(
nil
);
// 在線程中初始化 COM ，反正調用了此句，才能在線程中使用 COM
// 這是 windows 操作系統規定的，與 delphi 沒有關系。
// 你用 api 操作線程，在線程中訪問 COM 同樣需要這樣做。
try
DoExecute;
finally
CoUninitialize;
// 與初始化對應，解除線程訪問 COM 的能力。
end
;
end
else
DoExecute;
end
;
procedure
TFooThread
.
StartThread;
begin
end
;
end
.
先基於 TFooThread 繼承，代碼如下。
unit
uCountThread;
interface
uses
uFooThread;
type
TCountThread =
class
;
TOnCounted =
procedure
(Sender: TCountThread)
of
object
;
TCountThread =
class
(TFooThread)
private
procedure
Count;
procedure
DoOnCounted;
public
procedure
StartThread; override;
public
Num:
integer
;
Total:
integer
;
OnCounted: TOnCounted;
end
;
implementation
{ TCountThread }
procedure
TCountThread
.
Count;
var
i:
integer
;
begin
DoOnStatusMsg(
'開始計算...'
);
Total :=
0
;
if
Num >
0
then
for
i :=
1
to
Num
do
begin
Total := Total + i;
sleep(
10
);
// 故意變慢，實際代碼請刪除此行。
// 實際上為確保線程能夠及時退出
// 此處還應加上一個判斷是否出的標志，請大家自行思考。
// 這又是一個兩難的選擇。
// 加了判斷標志，退出容易了，但效率又低了。
// 所以，編程人員總是在效率與友好性中做出選擇。
// 且編且珍惜。
end
;
DoOnCounted;
//引發 OnCounted 事件，告知調用者。
DoOnStatusMsg(
'計算完成...'
);
end
;
procedure
TCountThread
.
DoOnCounted;
begin
// if Assigned(OnCounted) then
// 等價於 if OnCounted <> nil then
if
Assigned(OnCounted)
then
OnCounted(self);
end
;
procedure
TCountThread
.
StartThread;
begin
inherited
;
ExecProcInThread(Count);
// 把 Count 過程塞到線程中運行。
end
;
end
.
是不是簡短很多？下面是調用。
unit
uFrmMain;
interface
uses
Winapi
.
Windows, Winapi
.
Messages, System
.
SysUtils, System
.
Variants, System
.
Classes, Vcl
.
Graphics,
Vcl
.
Controls, Vcl
.
Forms, Vcl
.
Dialogs, Vcl
.
StdCtrls, uCountThread;
type
TFrmMain =
class
(TForm)
memMsg: TMemo;
edtNum: TEdit;
btnWork: TButton;
procedure
FormCreate(Sender: TObject);
procedure
FormDestroy(Sender: TObject);
procedure
btnWorkClick(Sender: TObject);
private
{ Private declarations }
FCountThread: TCountThread;
// 取名是一直是個有技術含量的事情。
// 推薦去掉類名的 T 換成 F 這樣的寫法。
procedure
DispMsg(AMsg:
string
);
procedure
OnThreadMsg(AMsg:
string
);
procedure
OnCounted(Sender: TCountThread);
public
{ Public declarations }
end
;
var
FrmMain: TFrmMain;
implementation
{
$R
*.dfm}
{ TFrmMain }
procedure
TFrmMain
.
btnWorkClick(Sender: TObject);
var
n:
integer
;
begin
btnWork
.
Enabled :=
false
;
n := StrToIntDef(edtNum
.
Text,
0
);
FCountThread
.
Num := n;
FCountThread
.
StartThread;
end
;
procedure
TFrmMain
.
DispMsg(AMsg:
string
);
begin
memMsg
.
Lines
.
Add(AMsg);
end
;
procedure
TFrmMain
.
FormCreate(Sender: TObject);
begin
FCountThread := TCountThread
.
Create(
false
);
// 此處不需要訪問 Com 所以用 false
FCountThread
.
OnStatusMsg := self
.
OnThreadMsg;
// 因為是在線程時空中引發的消息，故這里用了 OnThreadMsg;
FCountThread
.
OnCounted := self
.
OnCounted;
end
;
procedure
TFrmMain
.
FormDestroy(Sender: TObject);
begin
// 這里要注意，盡管我們在 TFooThread 中的析構函數中
// 寫了保證線程退出的函數。那也只是以防萬一的。
// 在線程手動 Free 之前，一定要確保線程代碼已經退出了 Execute
// 為了友好退出，又需要在計算代碼中加入判斷是否退出的標志。
// 請參考 TCountThread Count 中的注釋。
// 本教程一直反復強調“代碼退出Execute”這個概念。
// 用線程，就得負責一切，不可偷懶！
FCountThread
.
Free;
end
;
procedure
TFrmMain
.
OnCounted(Sender: TCountThread);
var
s:
string
;
begin
s := IntToStr(Sender
.
Num) +
'累加和為:'
;
s := s + IntToStr(Sender
.
Total);
OnThreadMsg(s);
// 因為這里是線程空間，所以需要用本函數。
// 而不是 DispMsg;
// 網絡組件，它的數據到達事件，其實是線程時空。要顯示信息
// 也需要 Synchronize; 這是很多初學者易犯的錯誤。
// 如果在線程時空中，不用 Synchronize 來操作 UI,就會出現時靈時不靈的狀態。
// 初學者所謂的運行不穩定，調試時又是正常。往往原因就是如此。
TThread
.
Synchronize(
nil
,
procedure
begin
btnWork
.
Enabled :=
true
;
// 恢復按鈕狀態。
end
);
end
;
procedure
TFrmMain
.
OnThreadMsg(AMsg:
string
);
begin
TThread
.
Synchronize(
nil
,
procedure
begin
DispMsg(AMsg);
end
);
end
;
end
.