1. 程式人生 > >delphi 講的比較詳細的多執行緒(推薦)

delphi 講的比較詳細的多執行緒(推薦)

procedure TForm1.Button1Click(Sender: TObject); 
var 
  i: Integer; 
begin 
  for i := 0 to 500000 do 
  begin 
    Canvas.TextOut(1010, IntToStr(i)); 
  endend

上面程式執行時, 我們的窗體基本是 "死" 的, 可以在你在程式執行期間拖動窗體試試...

Delphi 為我們提供了一個簡單的辦法(Application.ProcessMessages)來解決這個問題:
procedure TForm1.Button1Click(Sender: TObject); 
var
    i: Integer;  begin    for i := 0 to 500000 do    begin      Canvas.TextOut(1010, IntToStr(i));      Application.ProcessMessages;    endend

這個 Application.ProcessMessages; 一般用在比較費時的迴圈中, 它會檢查並先處理訊息佇列中的其他訊息.

但這算不上多執行緒, 譬如: 執行中你拖動窗體, 迴圈會暫停下來...

在使用多執行緒以前, 讓我們先簡單修改一下程式:
function MyFun: Integer; 
var 
  i: Integer; 
begin
    for i := 0 to 500000 do    begin      Form1.Canvas.Lock;      Form1.Canvas.TextOut(1010, IntToStr(i));      Form1.Canvas.Unlock;    end;    Result := 0end;    procedure TForm1.Button1Click(Sender: TObject);  begin    MyFun;  end

細數上面程式的變化:
1、首先這還不是多執行緒的, 也會讓窗體假 "死" 一會;
2、把執行程式碼寫在了一個函式裡, 但這個函式不屬於 TForm1 的方法, 所以使用 Canvas 是必須冠以名稱(Form1);
3、既然是個函式, (不管是否必要)都應該有返回值;
4、使用了 500001 次 Lock 和 Unlock.

Canvas.Lock 好比在說: Canvas(繪圖表面)正忙著呢, 其他想用 Canvas 的等會;
Canvas.Unlock : 用完了, 解鎖!

在 Canvas 中使用 Lock 和 Unlock 是個好習慣, 在不使用多執行緒的情況下這無所謂, 但保不準哪天程式會擴充套件為多執行緒的; 我們現在學習多執行緒, 當然應該用.

在 Delphi 中使用多執行緒有兩種方法: 呼叫 API、使用 TThread 類; 使用 API 的程式碼更簡單.
function
 MyFun(p: Pointer): Integer; stdcall;  var    i: Integer;  begin    for i := 0 to 500000 do    begin      Form1.Canvas.Lock;      Form1.Canvas.TextOut(1010, IntToStr(i));      Form1.Canvas.Unlock;    end;    Result := 0end;    procedure TForm1.Button1Click(Sender: TObject);  var    ID: THandle;  begin    CreateThread(nil0, @MyFun, nil0, ID);  end

程式碼分析:
CreateThread 一個執行緒後, 算上原來的主執行緒, 這樣程式就有兩個執行緒、是標準的多執行緒了;
CreateThread 第三個引數是函式指標, 新執行緒建立後將立即執行該函式, 函式執行完畢, 系統將銷燬此執行緒從而結束多執行緒的故事.

CreateThread 要使用的函式是系統級別的, 不能是某個類(譬如: TForm1)的方法, 並且有嚴格的格式(引數、返回值)要求, 不管你暫時是不是需要都必須按格式來;
因為是系統級呼叫, 還要綴上 stdcall, stdcall 是協調引數順序的, 雖然這裡只有一個引數沒有順序可言, 但這是使用系統函式的慣例.

CreateThread 還需要一個 var 引數來接受新建執行緒的 ID, 儘管暫時沒用, 但這也是格式; 其他引數以後再說吧.

這樣一個最簡單的多執行緒程式就出來了, 咱們再用 TThread 類實現一次
type 
  TMyThread = class(TThread) 
  protected 
    procedure Execute; override; 
  end; 
 
procedure TMyThread.Execute; 
var 
  i: Integer; 
begin 
  FreeOnTerminate := True; {這可以讓執行緒執行完畢後隨即釋放} 
  for i := 0 to 500000 do 
  begin 
    Form1.Canvas.Lock; 
    Form1.Canvas.TextOut(1010, IntToStr(i)); 
    Form1.Canvas.Unlock; 
  endend; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  TMyThread.Create(False); 
end; 
 
TThread 類有一個抽象方法(Execute), 因而是個抽象類, 抽象類只能繼承使用, 上面是繼承為 TMyThread.

繼承 TThread 主要就是實現抽象方法 Execute(把我們的程式碼寫在裡面), 等我們的 TMyThread 例項化後, 首先就會執行 Execute 方法中的程式碼.

按常規我們一般這樣去例項化:
procedure TForm1.Button1Click(Sender: TObject); 
var 
  MyThread: TMyThread; 
begin 
  MyThread := TMyThread.Create(False); 
end
因為 MyThread 變數在這裡毫無用處(並且編譯器還有提示), 所以不如直接寫做 TMyThread.Create(False);

我們還可以輕鬆解決一個問題, 如果: TMyThread.Create(True) ?
這樣執行緒建立後就不會立即呼叫 Execute, 可以在需要的時候再用 Resume 方法執行執行緒, 譬如:
procedure TForm1.Button1Click(Sender: TObject); 
var 
  MyThread: TMyThread; 
begin 
  MyThread := TMyThread.Create(True); 
  MyThread.Resume; 
end; 
 
//可簡化為: 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  with TMyThread.Create(True) do Resume; 
end

一、入門
㈠、
function CreateThread( 
  lpThreadAttributes: Pointer;           {安全設定} 
  dwStackSize: DWORD;                    {堆疊大小} 
  lpStartAddress: TFNThreadStartRoutine; {入口函式} 
  lpParameter: Pointer;                  {函式引數} 
  dwCreationFlags: DWORD;                {啟動選項} 
  var lpThreadId: DWORD                  {輸出執行緒 ID } 
): THandle; stdcall;                     {返回執行緒控制代碼} 

在 Windows 上建立一個執行緒, 離不開 CreateThread 函式;
TThread.Create 就是先呼叫了 BeginThread (Delphi 自定義的), BeginThread 又呼叫的 CreateThread.
既然有建立, 就該有釋放, CreateThread 對應的釋放函式是: ExitThread, 譬如下面程式碼:
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  ExitThread(0); {此句即可退出當前程式, 但不建議這樣使用} 
end

程式碼註釋:
當前程式是一個程序, 程序只是一個工作環境, 執行緒是工作者;
每個程序都會有一個啟動執行緒(或叫主執行緒), 也就是說: 我們之前大量的編碼都是寫給這個主執行緒的;
上面的 ExitThread(0); 就是退出這個主執行緒;
系統不允許一個沒有執行緒的程序存在, 所以程式就退出了.
另外: ExitThread 函式的引數是一個退出碼, 這個退出碼是給之後的其他函式用的, 這裡隨便給個無符號整數即可.

或許你會說: 這個 ExitThread 挺好用的; 其實不管是用 API 還是用 TThread 類寫多執行緒, 我們很少用到它; 因為:
1、假如直接使用 API 的 CreateThread, 它執行完入口函式後會自動退出, 無需 ExitThread;
2、用 TThread 類建立的執行緒又絕不能使用 ExitThread 退出; 因為使用 TThread 建立執行緒時會同時分配更多資源(譬如你自定義的成員、還有它的祖先類(TObject)分配的資源等等), 如果用 ExitThread 給草草退出了, 這些資源將得不到釋放而導致記憶體洩露. 儘管 Delphi 提供了 EndThread(其內部呼叫 ExitThread), 這也不需要我們手動操作(假如非要手動操作也是件很麻煩的事情, 因為很多時候你不知道執行緒是什麼時候執行完畢的).
除了 CreateThread, 還有一個 CreateRemoteThread, 可在其他程序中建立執行緒, 這不應該是現在學習的重點;
現在先集中精力把 CreateThread 的引數搞徹底.

倒著來吧, 先談談 CreateThread 將要返回的 "執行緒控制代碼".

"控制代碼" 類似指標, 但通過指標可讀寫物件, 通過控制代碼只是使用物件;
有控制代碼的物件一般都是系統級別的物件(或叫核心物件); 之所以給我們的是控制代碼而不是指標, 目的只有一個: "安全";
貌似通過控制代碼能做很多事情, 但一般把控制代碼提交到某個函式(一般是系統函式)後, 我們也就到此為止很難了解更多了; 事實上是系統並不相信我們.

不管是指標還是控制代碼, 都不過是記憶體中的一小塊資料(一般用結構描述), 微軟並沒有公開控制代碼的結構細節, 猜一下它應該包括: 真實的指標地址、訪問許可權設定、引用計數等等.

既然 CreateThread 可以返回一個控制代碼, 說明執行緒屬於 "核心物件".
實際上不管執行緒屬於哪個程序, 它們在系統的懷抱中是平等的; 在優先順序(後面詳談)相同的情況下, 系統會在相同的時間間隔內來執行一下每個執行緒, 不過這個間隔很小很小, 以至於讓我們誤以為程式是在不間斷地執行.

這時你應該有一個疑問: 系統在去執行其他執行緒的時候, 是怎麼記住前一個執行緒的資料狀態的?
有這樣一個結構 TContext, 它基本上是一個 CPU 暫存器的集合, 執行緒是資料就是通過這個結構切換的, 我們也可以通過 GetThreadContext 函式讀取暫存器看看.

附上這個結構 TContext(或叫: CONTEXT、_CONTEXT) 的定義:
PContext = ^TContext; 
_CONTEXT = record 
  ContextFlags: DWORD; 
  Dr0: DWORD; 
  Dr1: DWORD; 
  Dr2: DWORD; 
  Dr3: DWORD; 
  Dr6: DWORD; 
  Dr7: DWORD; 
  FloatSave: TFloatingSaveArea; 
  SegGs: DWORD; 
  SegFs: DWORD; 
  SegEs: DWORD; 
  SegDs: DWORD; 
  Edi: DWORD; 
  Esi: DWORD; 
  Ebx: DWORD; 
  Edx: DWORD; 
  Ecx: DWORD; 
  Eax: DWORD; 
  Ebp: DWORD; 
  Eip: DWORD; 
  SegCs: DWORD; 
  EFlags: DWORD; 
  Esp: DWORD; 
  SegSs: DWORD; 
end

CreateThread 的最後一個引數是 "執行緒的 ID";
既然可以返回控制代碼, 為什麼還要輸出這個 ID? 現在我知道的是:
1、執行緒的 ID 是唯一的; 而控制代碼可能不只一個, 譬如可以用 GetCurrentThread 獲取一個偽控制代碼、可以用 DuplicateHandle 複製一個控制代碼等等.
2、ID 比控制代碼更輕便.

在主執行緒中 GetCurrentThreadId、MainThreadID、MainInstance 獲取的都是主執行緒的 ID.
㈡、啟動選項
function CreateThread( 
  lpThreadAttributes: Pointer; 
  dwStackSize: DWORD; 
  lpStartAddress: TFNThreadStartRoutine; 
  lpParameter: Pointer; 
  dwCreationFlags: DWORD; {啟動選項} 
  var lpThreadId: DWORD 
): THandle; stdcall;
CreateThread 的倒數第二個引數 dwCreationFlags(啟動選項) 有兩個可選值:
0: 執行緒建立後立即執行入口函式;
CREATE_SUSPENDED: 執行緒建立後會掛起等待.

可用 ResumeThread 函式是恢復執行緒的執行; 可用 SuspendThread 再次掛起執行緒.
這兩個函式的引數都是執行緒控制代碼, 返回值是執行前的掛起計數.

什麼是掛起計數?
SuspendThread 會給這個數 +1; ResumeThread 會給這個數 -1; 但這個數最小是 0.
當這個數 = 0 時, 執行緒會執行; > 0 時會掛起.
如果被 SuspendThread 多次, 同樣需要 ResumeThread 多次才能恢復執行緒的執行.

在下面的例子中, 有新執行緒不斷給一個全域性變數賦隨機值;
同時窗體上的 Timer 控制元件每隔 1/10 秒就把這個變數寫在窗體標題;
在這個過程中演示了 ResumeThread、SuspendThread 兩個函式.

//上面圖片中演示的程式碼。 
unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, ExtCtrls; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    Button3: TButton; 
    Timer1: TTimer; 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
var 
  hThread: THandle; {執行緒控制代碼} 
  num: Integer;     {全域性變數, 用於記錄隨機數} 
 
{執行緒入口函式} 
function MyThreadFun(p: Pointer): Integer; stdcall; 
begin 
  while True do {假如執行緒不掛起, 這個迴圈將一直迴圈下去} 
  begin 
    num := Random(100); 
  end; 
  Result := 0end; 
 
{建立並掛起執行緒} 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  ID: DWORD; 
begin 
  hThread := CreateThread(nil0, @MyThreadFun, nil, CREATE_SUSPENDED, ID); 
  Button1.Enabled := False; 
end; 
 
{喚醒並繼續執行緒} 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  ResumeThread(hThread); 
end; 
 
{掛起執行緒} 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  SuspendThread(hThread); 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Timer1.Interval := 100end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  Text := IntToStr(num); 
end; 
 
end.
㈢、入口函式的引數
function CreateThread( 
  lpThreadAttributes: Pointer; 
  dwStackSize: DWORD; 
  lpStartAddress: TFNThreadStartRoutine; 
  lpParameter: Pointer;  {入口函式的引數} 
  dwCreationFlags: DWORD; 
  var lpThreadId: DWORD 
): THandle; stdcall;
執行緒入口函式的引數是個無型別指標(Pointer), 用它可以指定任何資料; 本例是把滑鼠點選窗體的座標傳遞給執行緒的入口函式, 每次點選窗體都會建立一個執行緒.

執行效果圖:

//上面演示的程式碼 
unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs; 
 
type 
  TForm1 = class(TForm) 
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
var 
  pt: TPoint; {這個座標點將會已指標的方式傳遞給執行緒, 它應該是全域性的} 
 
function MyThreadFun(p: Pointer): Integer; stdcall; 
var 
  i: Integer; 
  pt2: TPoint;       {因為指標引數給的點隨時都在變, 需用執行緒的區域性變數存起來} 
begin 
  pt2 := PPoint(p)^; {轉換} 
  for i := 0 to 1000000 do 
  begin 
    with Form1.Canvas do begin 
      Lock; 
      TextOut(pt2.X, pt2.Y, IntToStr(i)); 
      Unlock; 
    end; 
  end; 
  Result := 0end; 
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
var 
  ID: DWORD; 
begin 
  pt := Point(X, Y); 
  CreateThread(nil0, @MyThreadFun, @pt, 0, ID); 
  {下面這種寫法更好理解, 其實不必, 因為 PPoint 會自動轉換為 Pointer 的} 
  //CreateThread(nil, 0, @MyThreadFun, Pointer(@pt), 0, ID); 
end; 
 
end.

這個例子還有不嚴謹的地方: 當一個執行緒 Lock 窗體的 Canvas 時, 其他執行緒在等待; 執行緒在等待時, 其中的計數也還在增加. 這也就是說: 現在並沒有去處理執行緒的同步; 同步是多執行緒中最重要的課題, 快到了.

另外有個小技巧: 執行緒函式的引數是個 32 位(4個位元組)的指標, 僅就本例來講, 可以讓它的 "高16位" 和 "低16位" 分別攜帶 X 和 Y; 這樣就不需要哪個全域性的 pt 變量了.
其實在 Windows 的訊息中就是這樣傳遞座標的, 在 Windows 的訊息中一般高位元組是 Y、低位元組是 X; 咱們這麼來吧, 這樣還可以使用給訊息準備的一些方便的函式.

重寫本例程式碼(當然執行效果和窗體檔案都是一樣的):
unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs; 
 
type 
  TForm1 = class(TForm) 
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
function MyThreadFun(p: Pointer): Integer; stdcall; 
var 
  i: Integer; 
  x,y: Word; 
begin 
  x := LoWord(Integer(p)); 
  y := HiWord(Integer(p)); 
  {如果不使用 LoWord、HiWord 函式可以像下面這樣: } 
  //x := Integer(p); 
  //y := Integer(p) shr 16; 
  for i := 0 to 1000000 do 
  begin 
    with Form1.Canvas do begin 
      Lock; 
      TextOut(x, y, IntToStr(i)); 
      Unlock; 
    end; 
  end; 
  Result := 0end; 
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
var 
  ID: DWORD; 
  num: Integer; 
begin 
  num := MakeLong(X, Y); 
  {如果不使用 MekeLong、MakeWParam、MakeLParam、MakeResult 等函式, 可以像下面這樣: } 
  //num := Y shl 16 + X; 
  CreateThread(nil0, @MyThreadFun, Ptr(num), 0, ID); 
  {上面的 Ptr 是專門將一個數字轉換為指標的函式, 當然也可以這樣: } 
  //CreateThread(nil, 0, @MyThreadFun, Pointer(num), 0, ID); 
end; 
 
end.
㈣、入口函式的指標
function CreateThread( 
  lpThreadAttributes: Pointer; 
  dwStackSize: DWORD; 
  lpStartAddress: TFNThreadStartRoutine; {入口函式的指標} 
  lpParameter: Pointer;  
  dwCreationFlags: DWORD; 
  var lpThreadId: DWORD 
): THandle; stdcall;


到了入口函數了, 學到這個地方, 我查了一個入口函式的標準定義, 這個函式的標準返回值應該是 DWORD, 不過這函式在 Delphi 的 System 單元定義的是: TThreadFunc = function(Parameter: Pointer): Integer; 我以後會盡量使用 DWORD 做入口函式的返回值.

這個返回值有什麼用呢?
等執行緒退出後, 我們用 GetExitCodeThread 函式獲取的退出碼就是這個返回值!

如果執行緒沒有退出, GetExitCodeThread 獲取的退出碼將是一個常量 STILL_ACTIVE (259); 這樣我們就可以通過退出碼來判斷執行緒是否已退出.

還有一個問題: 前面也提到過, 執行緒函式不能是某個類的方法! 假如我們非要執行緒去執行類中的一個方法能否實現呢?
儘管可以用 Addr(類名.方法名) 或 MethodAddress('published 區的方法名') 獲取類中方法的地址, 但都不能當做執行緒的入口函式, 原因可能是因為類中的方法的地址是在例項化為物件時動態分配的.
後來換了個思路, 其實很簡單: 線上程函式中再呼叫方法不就得了, 估計 TThread 也應該是這樣.

下面的例子就嘗試了用執行緒呼叫 TForm1 類中的方法, 並測試了退出碼的相關問題.

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    private 
      procedure FormProc; {準備給執行緒使用的方法} 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
var 
  hThread: THandle; 
 
{執行緒入口函式} 
function MyThreadFun(p: Pointer): DWORD; stdcall; 
begin 
  Form1.FormProc; {呼叫 TForm1 類的方法} 
  Result := 99;   {這個返回值將成為執行緒的退出程式碼, 99 是我隨意給的數字} 
end; 
 
{TForm1 的方法, 本例中是給執行緒的入口函式呼叫的} 
procedure TForm1.FormProc; 
var 
  i: Integer; 
begin 
  for i := 0 to 200000 do 
  begin 
    with Form1.Canvas do begin 
      Lock; 
      TextOut(1010, IntToStr(i)); 
      Unlock; 
    end; 
  endend; 
 
{建立並執行執行緒} 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  ID: DWORD; 
begin 
  hThread := CreateThread(nil0, @MyThreadFun, nil0, ID); 
end; 
 
{獲取執行緒的退出程式碼, 並判斷執行緒是否退出} 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  ExitCode: DWORD; 
begin 
  GetExitCodeThread(hThread, ExitCode); 
 
  if hThread = 0 then 
  begin 
    Text := '執行緒還未啟動'; 
    Exit; 
  end; 
 
  if ExitCode = STILL_ACTIVE then 
    Text := Format('執行緒退出程式碼是: %d, 表示執行緒還未退出', [ExitCode]) 
  else 
    Text := Format('執行緒已退出, 退出程式碼是: %d', [ExitCode]); 
end; 
 
end.
㈤、堆疊大小
function CreateThread( 
  lpThreadAttributes: Pointer; 
  dwStackSize: DWORD;  {堆疊大小} 
  lpStartAddress: TFNThreadStartRoutine;  
  lpParameter: Pointer;  
  dwCreationFlags: DWORD; 
  var lpThreadId: DWORD 
): THandle; stdcall;


CreateThread 的第二個引數是分配給執行緒的堆疊大小.
這首先這可以讓我們知道: 每個執行緒都有自己獨立的堆疊(也擁有自己的訊息佇列).

什麼是堆疊? 其實堆是堆、棧是棧, 有時 "棧" 也被叫做 "堆疊".
它們都是程序中的記憶體區域, 主要是存取方式不同(棧:先進後出; 堆:先進先出);
"棧"(或叫堆疊)適合存取臨時而輕便的變數, 主要用來儲存區域性變數; 譬如 for i := 0 to 99 do 中的 i 就只能存於棧中, 你把一個全域性的變數用於 for 迴圈計數是不可以的.

現在我們知道了執行緒有自己的 "棧", 並且在建立執行緒時可以分配棧的大小.

前面所有的例子中, 這個值都是 0, 這表示使用系統預設的大小, 預設和主執行緒棧的大小一樣, 如果不夠用會自動增長;
那主執行緒的棧有多大? 這個值是可以設定的: Project -> Options -> linker -> memory size(如圖)

棧是私有的但堆是公用的, 如果不同的執行緒都來使用一個全域性變數有點亂套;
為解決這個問題 Delphi 為我們提供了一個類似 var 的 ThreadVar 關鍵字, 執行緒在使用 ThreadVar 宣告的全域性變數時會在各自的棧中留一個副本, 這樣就解決了衝突. 不過還是儘量使用區域性變數, 或者在繼承 TThread 時使用類的成員變數, 因為 ThreadVar 的效率不好, 據說比區域性變數能慢 10 倍.

在下面的例子就測試了用 var 和 ThreadVar 定義變數的不同.
使用 var 效果圖:

使用 ThreadVar 效果圖:

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
//var num: Integer;     {全域性變數} 
threadvar num: Integer; {支援多執行緒的全域性變數} 
 
function MyThreadFun(p: Pointer): DWORD; stdcall; 
var 
  py: Integer; 
begin 
  py := Integer(p); 
  while True do 
  begin 
    Inc(num); 
    with Form1.Canvas do begin 
      Lock; 
      TextOut(20, py, IntToStr(num)); 
      Unlock; 
    end; 
    Sleep(1000); {然執行緒掛起 1 秒鐘再繼續} 
  endend; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  ID: DWORD; 
begin 
  {借入口函式的引數傳遞了一個座標點中的 Y 值, 以讓各執行緒把結果輸出在不同位置} 
  CreateThread(nil0, @MyThreadFun, Ptr(20), 0, ID); 
  CreateThread(nil0, @MyThreadFun, Ptr(40), 0, ID); 
  CreateThread(nil0, @MyThreadFun, Ptr(60), 0, ID); 
end; 
 
end.
㈥、安全設定
function CreateThread( 
  lpThreadAttributes: Pointer; {安全設定} 
  dwStackSize: DWORD; 
  lpStartAddress: TFNThreadStartRoutine;  
  lpParameter: Pointer;  
  dwCreationFlags: DWORD; 
  var lpThreadId: DWORD 
): THandle; stdcall;
CreateThread 的第一個引數 lpThreadAttributes 是指向 TSecurityAttributes 結構的指標, 一般都是置為 nil, 這表示沒有訪問限制; 該結構的定義是:
//TSecurityAttributes(又名: SECURITY_ATTRIBUTES、_SECURITY_ATTRIBUTES) 
_SECURITY_ATTRIBUTES = record 
  nLength: DWORD;                {結構大小} 
  lpSecurityDescriptor: Pointer; {預設 nil; 這是另一個結構 TSecurityDescriptor 的指標} 
  bInheritHandle: BOOL;          {預設 False, 表示不可繼承} 
end; 
 
//TSecurityDescriptor(又名: SECURITY_DESCRIPTOR、_SECURITY_DESCRIPTOR) 
_SECURITY_DESCRIPTOR = record 
  Revision: Byte; 
  Sbz1: Byte; 
  Control: SECURITY_DESCRIPTOR_CONTROL; 
  Owner: PSID; 
  Group: PSID; 
  Sacl: PACL; 
  Dacl: PACL; 
end;
夠複雜的, 但我們在多執行緒程式設計時不需要去設定它們, 大都是使用預設設定(也就是賦值為 nil).

我覺得有必要在此刻了解的是: 建立系統核心物件時一般都有這個屬性(TSecurityAttributes);
在接下來多執行緒的課題中要使用一些核心物件, 不如先盤點一下, 到時碰到這個屬性時給個 nil 即可, 不必再費神.
{建立事件} 
function CreateEvent( 
  lpEventAttributes: PSecurityAttributes; {!} 
  bManualReset: BOOL; 
  bInitialState: BOOL; 
  lpName: PWideChar 
): THandle; stdcall; 
 
{建立互斥} 
function CreateMutex( 
  lpMutexAttributes: PSecurityAttributes; {!} 
  bInitialOwner: BOOL; 
  lpName: PWideChar 
): THandle; stdcall; 
 
{建立訊號} 
function CreateSemaphore( 
  lpSemaphoreAttributes: PSecurityAttributes; {!} 
  lInitialCount: Longint; 
  lMaximumCount: Longint; 
  lpName: PWideChar 
): THandle; stdcall; 
 
{建立等待計時器} 
function CreateWaitableTimer( 
  lpTimerAttributes: PSecurityAttributes; {!} 
  bManualReset: BOOL; 
  lpTimerName: PWideChar 
): THandle; stdcall; 
上面的四個系統核心物件(事件、互斥、訊號、計時器)都是執行緒同步的手段, 從這也能看出處理執行緒同步的複雜性; 不過這還不是全部, Windows Vista 開始又增加了 Condition variables(條件變數)、Slim Reader-Writer Locks(讀寫鎖)等同步手段.

不過最簡單、最輕便(速度最快)的同步手段還是 CriticalSection(臨界區), 但它不屬於系統核心物件, 當然也就沒有控制代碼、沒有 TSecurityAttributes 這個安全屬性, 這也導致它不能跨程序使用; 不過寫多執行緒時一般不用跨程序, 所以 CriticalSection 應該是最常用的同步手段.

二、臨界區。
先看一段程式, 程式碼檔案:
unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls; 
 
type 
  TForm1 = class(TForm) 
    ListBox1: TListBox; 
    Button1: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
  end; 
 
var 
  Form1: TForm1;