程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> Delphi 多線程編程(1)

Delphi 多線程編程(1)

編輯:Delphi

多線程應該是編程工作者的基礎技能, 但這個基礎我從來沒學過,所以僅僅是看上去會一些,明白了2+2的時候,其實我還不知道1+1。

開始本應該是一篇洋洋灑灑的文字, 不過我還是提倡先做起來, 在嘗試中去理解.
先試試這個:
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to 500000 do
  begin
    Canvas.TextOut(10, 10, IntToStr(i));
  end;
end;

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

Delphi 為我們提供了一個簡單的辦法(Application.ProcessMessages)來解決這個問題:

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

這個 Application.ProcessMessages; 一般用在比較費時的循環中, 它會檢查並先處理消息隊列中的其他消息.

但這算不上多線程, 譬如: 運行中你拖動窗體, 循環會暫停下來...

在使用多線程以前, 讓我們先簡單修改一下程序:

function MyFun: Integer;
var
  i: Integer;
begin
  for i := 0 to 500000 do
  begin
    Form1.Canvas.Lock;
    Form1.Canvas.TextOut(10, 10, IntToStr(i));
    Form1.Canvas.Unlock;
  end;
  Result := 0;
end;
 
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(10, 10, IntToStr(i));
    Form1.Canvas.Unlock;
  end;
  Result := 0;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  ID: THandle;
begin
  CreateThread(nil, 0, @MyFun, nil, 0, 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(10, 10, IntToStr(i));
    Form1.Canvas.Unlock;
  end;
end;
 
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 := 0;
end;
 
{建立並掛起線程}
procedure TForm1.Button1Click(Sender: TObject);
var
  ID: DWORD;
begin
  hThread := CreateThread(nil, 0, @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 := 100;
end;
 
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 := 0;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ID: DWORD;
begin
  pt := Point(X, Y);
  CreateThread(nil, 0, @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 := 0;
end;
 
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(nil, 0, @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(10, 10, IntToStr(i));
      Unlock;
    end;
  end;
end;
 
{建立並執行線程}
procedure TForm1.Button1Click(Sender: TObject);
var
  ID: DWORD;
begin
  hThread := CreateThread(nil, 0, @MyThreadFun, nil, 0, 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;

 

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved