delphi 讲的比较详细的多线程

在了解多线程之前我们先了解一下进程和线程的关系

一个程序至少有一个主进程,一个进程至少有一个线程。

为了保证线程的安全性请大家看看下面介绍 Delphi多线程同步的一些处理方案大家可以参考:http://www.cr173.com/html/16747_1.html

主线程又程为UI线程。

进程和线程的主要差别在于它们是不同的操作系统资源管理方式。进程有独立的地址空间,一个进程崩溃后,在保护模式下不会对其它进程产生影响,而线程只是一个进程中的不同执行路径。线程有自己的堆栈和局部变量,但线程之间没有单独的地址空间,一个线程死掉就等于整个进程死掉,所以多进程的程序要比多线程的程序健壮,但在进程切换时,耗费资源较大,效率要差一些。但对于一些要求同时进行并且又要共享某些变量的并发操作,只能用线程,不能用进程。如果有兴趣深入的话,我建议你们看看《现代操作系统》或者《操作系统的设计与实现》。对就个问题说得比较清楚。

多线程应该是编程工作者的基础技能, 但这个基础我从来没学过,所以仅仅是看上去会一些,明白了2+2的时候,其实我还不知道1+1。

开始本应该是一篇洋洋洒洒的文字, 不过我还是提倡先做起来, 在尝试中去理解.


先试试这个:

  1.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  2.  
    var 
  3.  
      i: Integer; 
  4.  
    begin 
  5.  
       for i :=  0  to  500000  do 
  6.  
       begin 
  7.  
        Canvas.TextOut( 1010, IntToStr(i)); 
  8.  
       end
  9.  
    end

上面程序运行时, 我们的窗体基本是 "死" 的, 可以在你在程序运行期间拖动窗体试试...

Delphi 为我们提供了一个简单的办法(Application.ProcessMessages)来解决这个问题:
  1.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  2.  
    var 
  3.  
      i: Integer; 
  4.  
    begin 
  5.  
       for i :=  0  to  500000  do 
  6.  
       begin 
  7.  
        Canvas.TextOut( 1010, IntToStr(i)); 
  8.  
        Application.ProcessMessages; 
  9.  
       end
  10.  
    end

这个 Application.ProcessMessages; 一般用在比较费时的循环中, 它会检查并先处理消息队列中的其他消息.

但这算不上多线程, 譬如: 运行中你拖动窗体, 循环会暂停下来...

在使用多线程以前, 让我们先简单修改一下程序:
  1.  
    function  MyFun: Integer; 
  2.  
    var 
  3.  
      i: Integer; 
  4.  
    begin 
  5.  
       for i :=  0  to  500000  do 
  6.  
       begin 
  7.  
        Form1.Canvas.Lock; 
  8.  
        Form1.Canvas.TextOut( 1010, IntToStr(i)); 
  9.  
        Form1.Canvas.Unlock; 
  10.  
       end
  11.  
      Result :=  0
  12.  
    end
  13.  
     
  14.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  15.  
    begin 
  16.  
      MyFun; 
  17.  
    end

细数上面程序的变化:
1、首先这还不是多线程的, 也会让窗体假 "死" 一会;
2、把执行代码写在了一个函数里, 但这个函数不属于 TForm1 的方法, 所以使用 Canvas 是必须冠以名称(Form1);
3、既然是个函数, (不管是否必要)都应该有返回值;
4、使用了 500001 次 Lock 和 Unlock.

Canvas.Lock 好比在说: Canvas(绘图表面)正忙着呢, 其他想用 Canvas 的等会;
Canvas.Unlock : 用完了, 解锁!

在 Canvas 中使用 Lock 和 Unlock 是个好习惯, 在不使用多线程的情况下这无所谓, 但保不准哪天程序会扩展为多线程的; 我们现在学习多线程, 当然应该用.

在 Delphi 中使用多线程有两种方法: 调用 API、使用 TThread 类; 使用 API 的代码更简单.
  1.  
    function  MyFun(p: Pointer): Integer;  stdcall
  2.  
    var 
  3.  
      i: Integer; 
  4.  
    begin 
  5.  
       for i :=  0  to  500000  do 
  6.  
       begin 
  7.  
        Form1.Canvas.Lock; 
  8.  
        Form1.Canvas.TextOut( 1010, IntToStr(i)); 
  9.  
        Form1.Canvas.Unlock; 
  10.  
       end
  11.  
      Result :=  0
  12.  
    end
  13.  
     
  14.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  15.  
    var 
  16.  
      ID: THandle; 
  17.  
    begin 
  18.  
      CreateThread( nil0, @MyFun,  nil0, ID); 
  19.  
    end

代码分析:
CreateThread 一个线程后, 算上原来的主线程, 这样程序就有两个线程、是标准的多线程了;
CreateThread 第三个参数是函数指针, 新线程建立后将立即执行该函数, 函数执行完毕, 系统将销毁此线程从而结束多线程的故事.

CreateThread 要使用的函数是系统级别的, 不能是某个类(譬如: TForm1)的方法, 并且有严格的格式(参数、返回值)要求, 不管你暂时是不是需要都必须按格式来;
因为是系统级调用, 还要缀上 stdcall, stdcall 是协调参数顺序的, 虽然这里只有一个参数没有顺序可言, 但这是使用系统函数的惯例.

CreateThread 还需要一个 var 参数来接受新建线程的 ID, 尽管暂时没用, 但这也是格式; 其他参数以后再说吧.

这样一个最简单的多线程程序就出来了, 咱们再用 TThread 类实现一次
  1.  
    type 
  2.  
       TMyThread =  class(TThread) 
  3.  
       protected 
  4.  
         procedure  Execute;  override
  5.  
       end
  6.  
     
  7.  
    procedure  TMyThread.Execute; 
  8.  
    var 
  9.  
      i: Integer; 
  10.  
    begin 
  11.  
      FreeOnTerminate := True;  {这可以让线程执行完毕后随即释放} 
  12.  
       for i :=  0  to  500000  do 
  13.  
       begin 
  14.  
        Form1.Canvas.Lock; 
  15.  
        Form1.Canvas.TextOut( 1010, IntToStr(i)); 
  16.  
        Form1.Canvas.Unlock; 
  17.  
       end
  18.  
    end
  19.  
     
  20.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  21.  
    begin 
  22.  
      TMyThread.Create(False); 
  23.  
    end
  24.  
     
TThread 类有一个抽象方法(Execute), 因而是个抽象类, 抽象类只能继承使用, 上面是继承为 TMyThread.

继承 TThread 主要就是实现抽象方法 Execute(把我们的代码写在里面), 等我们的 TMyThread 实例化后, 首先就会执行 Execute 方法中的代码.

按常规我们一般这样去实例化:
  1.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  2.  
    var 
  3.  
      MyThread: TMyThread; 
  4.  
    begin 
  5.  
      MyThread := TMyThread.Create(False); 
  6.  
    end
因为 MyThread 变量在这里毫无用处(并且编译器还有提示), 所以不如直接写做 TMyThread.Create(False);

我们还可以轻松解决一个问题, 如果: TMyThread.Create(True) ?
这样线程建立后就不会立即调用 Execute, 可以在需要的时候再用 Resume 方法执行线程, 譬如:
  1.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  2.  
    var 
  3.  
      MyThread: TMyThread; 
  4.  
    begin 
  5.  
      MyThread := TMyThread.Create(True); 
  6.  
      MyThread.Resume; 
  7.  
    end
  8.  
     
  9.  
    //可简化为:  
  10.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  11.  
    begin 
  12.  
       with TMyThread.Create(True)  do Resume; 
  13.  
    end

一、入门
㈠、
  1.  
    function  CreateThread
  2.  
      lpThreadAttributes: Pointer;            {安全设置}  
  3.  
      dwStackSize: DWORD;                     {堆栈大小}  
  4.  
      lpStartAddress: TFNThreadStartRoutine;  {入口函数}  
  5.  
      lpParameter: Pointer;                   {函数参数}  
  6.  
      dwCreationFlags: DWORD;                 {启动选项}  
  7.  
       var  lpThreadId: DWORD                   {输出线程 ID }  
  8.  
    ): THandle;  stdcall;                      {返回线程句柄} 

在 Windows 上建立一个线程, 离不开 CreateThread 函数;
TThread.Create 就是先调用了 BeginThread (Delphi 自定义的), BeginThread 又调用的 CreateThread.
既然有建立, 就该有释放, CreateThread 对应的释放函数是: ExitThread, 譬如下面代码:
  1.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  2.  
    begin 
  3.  
      ExitThread( 0);  {此句即可退出当前程序, 但不建议这样使用} 
  4.  
    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) 的定义:
  1.  
    PContext = ^TContext; 
  2.  
    _CONTEXT =  record 
  3.  
      ContextFlags: DWORD; 
  4.  
      Dr0: DWORD; 
  5.  
      Dr1: DWORD; 
  6.  
      Dr2: DWORD; 
  7.  
      Dr3: DWORD; 
  8.  
      Dr6: DWORD; 
  9.  
      Dr7: DWORD; 
  10.  
      FloatSave: TFloatingSaveArea; 
  11.  
      SegGs: DWORD; 
  12.  
      SegFs: DWORD; 
  13.  
      SegEs: DWORD; 
  14.  
      SegDs: DWORD; 
  15.  
      Edi: DWORD; 
  16.  
      Esi: DWORD; 
  17.  
      Ebx: DWORD; 
  18.  
      Edx: DWORD; 
  19.  
      Ecx: DWORD; 
  20.  
      Eax: DWORD; 
  21.  
      Ebp: DWORD; 
  22.  
      Eip: DWORD; 
  23.  
      SegCs: DWORD; 
  24.  
      EFlags: DWORD; 
  25.  
      Esp: DWORD; 
  26.  
      SegSs: DWORD; 
  27.  
    end

CreateThread 的最后一个参数是 "线程的 ID";
既然可以返回句柄, 为什么还要输出这个 ID? 现在我知道的是:
1、线程的 ID 是唯一的; 而句柄可能不只一个, 譬如可以用 GetCurrentThread 获取一个伪句柄、可以用 DuplicateHandle 复制一个句柄等等.
2、ID 比句柄更轻便.

在主线程中 GetCurrentThreadId、MainThreadID、MainInstance 获取的都是主线程的 ID.
㈡、启动选项
  1.  
    function  CreateThread
  2.  
      lpThreadAttributes: Pointer; 
  3.  
      dwStackSize: DWORD; 
  4.  
      lpStartAddress: TFNThreadStartRoutine; 
  5.  
      lpParameter: Pointer; 
  6.  
      dwCreationFlags: DWORD;  {启动选项}  
  7.  
       var  lpThreadId: DWORD 
  8.  
    ): THandle;  stdcall;
CreateThread 的倒数第二个参数 dwCreationFlags(启动选项) 有两个可选值:
0: 线程建立后立即执行入口函数;
CREATE_SUSPENDED: 线程建立后会挂起等待.

可用 ResumeThread 函数是恢复线程的运行; 可用 SuspendThread 再次挂起线程.
这两个函数的参数都是线程句柄, 返回值是执行前的挂起计数.

什么是挂起计数?
SuspendThread 会给这个数 +1; ResumeThread 会给这个数 -1; 但这个数最小是 0.
当这个数 = 0 时, 线程会运行; > 0 时会挂起.
如果被 SuspendThread 多次, 同样需要 ResumeThread 多次才能恢复线程的运行.

在下面的例子中, 有新线程不断给一个全局变量赋随机值;
同时窗体上的 Timer 控件每隔 1/10 秒就把这个变量写在窗体标题;
在这个过程中演示了 ResumeThread、SuspendThread 两个函数.

  1.  
    //上面图片中演示的代码。  
  2.  
    unit Unit1; 
  3.  
     
  4.  
    interface 
  5.  
     
  6.  
    uses 
  7.  
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  8.  
      Dialogs, StdCtrls, ExtCtrls; 
  9.  
     
  10.  
    type 
  11.  
       TForm1 =  class(TForm) 
  12.  
        Button1: TButton; 
  13.  
        Button2: TButton; 
  14.  
        Button3: TButton; 
  15.  
        Timer1: TTimer; 
  16.  
         procedure  Button1Click(Sender: TObject); 
  17.  
         procedure  Button2Click(Sender: TObject); 
  18.  
         procedure  Button3Click(Sender: TObject); 
  19.  
         procedure  FormCreate(Sender: TObject); 
  20.  
         procedure  Timer1Timer(Sender: TObject); 
  21.  
       end
  22.  
     
  23.  
    var 
  24.  
      Form1: TForm1; 
  25.  
     
  26.  
    implementation 
  27.  
     
  28.  
    {$R *.dfm} 
  29.  
     
  30.  
    var 
  31.  
      hThread: THandle;  {线程句柄} 
  32.  
      num: Integer;      {全局变量, 用于记录随机数} 
  33.  
     
  34.  
    {线程入口函数} 
  35.  
    function  MyThreadFun(p: Pointer): Integer;  stdcall
  36.  
    begin 
  37.  
       while True  do  {假如线程不挂起, 这个循环将一直循环下去} 
  38.  
       begin 
  39.  
        num := Random( 100); 
  40.  
       end
  41.  
      Result :=  0
  42.  
    end
  43.  
     
  44.  
    {建立并挂起线程} 
  45.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  46.  
    var 
  47.  
      ID: DWORD; 
  48.  
    begin 
  49.  
      hThread := CreateThread( nil0, @MyThreadFun,  nil, CREATE_SUSPENDED, ID); 
  50.  
      Button1.Enabled := False; 
  51.  
    end
  52.  
     
  53.  
    {唤醒并继续线程} 
  54.  
    procedure  TForm1.Button2Click(Sender: TObject); 
  55.  
    begin 
  56.  
      ResumeThread(hThread); 
  57.  
    end
  58.  
     
  59.  
    {挂起线程} 
  60.  
    procedure  TForm1.Button3Click(Sender: TObject); 
  61.  
    begin 
  62.  
      SuspendThread(hThread); 
  63.  
    end
  64.  
     
  65.  
    procedure  TForm1.FormCreate(Sender: TObject); 
  66.  
    begin 
  67.  
      Timer1.Interval :=  100
  68.  
    end
  69.  
     
  70.  
    procedure  TForm1.Timer1Timer(Sender: TObject); 
  71.  
    begin 
  72.  
      Text := IntToStr(num); 
  73.  
    end
  74.  
     
  75.  
    end.
㈢、入口函数的参数
  1.  
    function  CreateThread
  2.  
      lpThreadAttributes: Pointer; 
  3.  
      dwStackSize: DWORD; 
  4.  
      lpStartAddress: TFNThreadStartRoutine; 
  5.  
      lpParameter: Pointer;   {入口函数的参数}  
  6.  
      dwCreationFlags: DWORD; 
  7.  
       var  lpThreadId: DWORD 
  8.  
    ): THandle;  stdcall;
线程入口函数的参数是个无类型指针(Pointer), 用它可以指定任何数据; 本例是把鼠标点击窗体的坐标传递给线程的入口函数, 每次点击窗体都会创建一个线程.

运行效果图:

  1.  
    //上面演示的代码  
  2.  
    unit Unit1; 
  3.  
     
  4.  
    interface 
  5.  
     
  6.  
    uses 
  7.  
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  8.  
      Dialogs; 
  9.  
     
  10.  
    type 
  11.  
       TForm1 =  class(TForm) 
  12.  
         procedure  FormMouseUp(Sender: TObject; Button: TMouseButton; 
  13.  
          Shift: TShiftState; X, Y: Integer)
  14.  
       end
  15.  
     
  16.  
    var 
  17.  
      Form1: TForm1; 
  18.  
     
  19.  
    implementation 
  20.  
     
  21.  
    {$R *.dfm} 
  22.  
     
  23.  
    var 
  24.  
      pt: TPoint;  {这个坐标点将会已指针的方式传递给线程, 它应该是全局的} 
  25.  
     
  26.  
    function  MyThreadFun(p: Pointer): Integer;  stdcall
  27.  
    var 
  28.  
      i: Integer; 
  29.  
      pt2: TPoint;        {因为指针参数给的点随时都在变, 需用线程的局部变量存起来} 
  30.  
    begin 
  31.  
      pt2 := PPoint(p)^;  {转换} 
  32.  
       for i :=  0  to  1000000  do 
  33.  
       begin 
  34.  
         with Form1.Canvas  do  begin 
  35.  
          Lock; 
  36.  
          TextOut(pt2.X, pt2.Y, IntToStr(i)); 
  37.  
          Unlock; 
  38.  
         end
  39.  
       end
  40.  
      Result :=  0
  41.  
    end
  42.  
     
  43.  
    procedure  TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; 
  44.  
      Shift: TShiftState; X, Y: Integer)
  45.  
    var 
  46.  
      ID: DWORD; 
  47.  
    begin 
  48.  
      pt := Point(X, Y); 
  49.  
      CreateThread( nil0, @MyThreadFun, @pt,  0, ID); 
  50.  
       {下面这种写法更好理解, 其实不必, 因为 PPoint 会自动转换为 Pointer 的} 
  51.  
       //CreateThread(nil, 0, @MyThreadFun, Pointer(@pt), 0, ID);  
  52.  
    end
  53.  
     
  54.  
    end.

这个例子还有不严谨的地方: 当一个线程 Lock 窗体的 Canvas 时, 其他线程在等待; 线程在等待时, 其中的计数也还在增加. 这也就是说: 现在并没有去处理线程的同步; 同步是多线程中最重要的课题, 快到了.

另外有个小技巧: 线程函数的参数是个 32 位(4个字节)的指针, 仅就本例来讲, 可以让它的 "高16位" 和 "低16位" 分别携带 X 和 Y; 这样就不需要哪个全局的 pt 变量了.
其实在 Windows 的消息中就是这样传递坐标的, 在 Windows 的消息中一般高字节是 Y、低字节是 X; 咱们这么来吧, 这样还可以使用给消息准备的一些方便的函数.

重写本例代码(当然运行效果和窗体文件都是一样的):
  1.  
    unit Unit1; 
  2.  
     
  3.  
    interface 
  4.  
     
  5.  
    uses 
  6.  
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  7.  
      Dialogs; 
  8.  
     
  9.  
    type 
  10.  
       TForm1 =  class(TForm) 
  11.  
         procedure  FormMouseUp(Sender: TObject; Button: TMouseButton; 
  12.  
          Shift: TShiftState; X, Y: Integer)
  13.  
       end
  14.  
     
  15.  
    var 
  16.  
      Form1: TForm1; 
  17.  
     
  18.  
    implementation 
  19.  
     
  20.  
    {$R *.dfm} 
  21.  
     
  22.  
    function  MyThreadFun(p: Pointer): Integer;  stdcall
  23.  
    var 
  24.  
      i: Integer; 
  25.  
      x,y: Word; 
  26.  
    begin 
  27.  
      x := LoWord(Integer(p)); 
  28.  
      y := HiWord(Integer(p)); 
  29.  
       {如果不使用 LoWord、HiWord 函数可以像下面这样: } 
  30.  
       //x := Integer(p);  
  31.  
       //y := Integer(p) shr 16;  
  32.  
       for i :=  0  to  1000000  do 
  33.  
       begin 
  34.  
         with Form1.Canvas  do  begin 
  35.  
          Lock; 
  36.  
          TextOut(x, y, IntToStr(i)); 
  37.  
          Unlock; 
  38.  
         end
  39.  
       end
  40.  
      Result :=  0
  41.  
    end
  42.  
     
  43.  
    procedure  TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; 
  44.  
      Shift: TShiftState; X, Y: Integer)
  45.  
    var 
  46.  
      ID: DWORD; 
  47.  
      num: Integer; 
  48.  
    begin 
  49.  
      num := MakeLong(X, Y); 
  50.  
       {如果不使用 MekeLong、MakeWParam、MakeLParam、MakeResult 等函数, 可以像下面这样: } 
  51.  
       //num := Y shl 16 + X;  
  52.  
      CreateThread( nil0, @MyThreadFun, Ptr(num),  0, ID); 
  53.  
       {上面的 Ptr 是专门将一个数字转换为指针的函数, 当然也可以这样: } 
  54.  
       //CreateThread(nil, 0, @MyThreadFun, Pointer(num), 0, ID);  
  55.  
    end
  56.  
     
  57.  
    end.
㈣、入口函数的指针
  1.  
    function  CreateThread
  2.  
      lpThreadAttributes: Pointer; 
  3.  
      dwStackSize: DWORD; 
  4.  
      lpStartAddress: TFNThreadStartRoutine;  {入口函数的指针}  
  5.  
      lpParameter: Pointer;  
  6.  
      dwCreationFlags: DWORD; 
  7.  
       var  lpThreadId: DWORD 
  8.  
    ): THandle;  stdcall;


到了入口函数了, 学到这个地方, 我查了一个入口函数的标准定义, 这个函数的标准返回值应该是 DWORD, 不过这函数在 Delphi 的 System 单元定义的是: TThreadFunc = function(Parameter: Pointer): Integer; 我以后会尽量使用 DWORD 做入口函数的返回值.

这个返回值有什么用呢?
等线程退出后, 我们用 GetExitCodeThread 函数获取的退出码就是这个返回值!

如果线程没有退出, GetExitCodeThread 获取的退出码将是一个常量 STILL_ACTIVE (259); 这样我们就可以通过退出码来判断线程是否已退出.

还有一个问题: 前面也提到过, 线程函数不能是某个类的方法! 假如我们非要线程去执行类中的一个方法能否实现呢?
尽管可以用 Addr(类名.方法名) 或 MethodAddress('published 区的方法名') 获取类中方法的地址, 但都不能当做线程的入口函数, 原因可能是因为类中的方法的地址是在实例化为对象时动态分配的.
后来换了个思路, 其实很简单: 在线程函数中再调用方法不就得了, 估计 TThread 也应该是这样.

下面的例子就尝试了用线程调用 TForm1 类中的方法, 并测试了退出码的相关问题.

  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.  
        Button2: TButton; 
  13.  
         procedure  Button1Click(Sender: TObject); 
  14.  
         procedure  Button2Click(Sender: TObject); 
  15.  
         private 
  16.  
           procedure  FormProc;  {准备给线程使用的方法} 
  17.  
       end
  18.  
     
  19.  
    var 
  20.  
      Form1: TForm1; 
  21.  
     
  22.  
    implementation 
  23.  
     
  24.  
    {$R *.dfm} 
  25.  
     
  26.  
    var 
  27.  
      hThread: THandle; 
  28.  
     
  29.  
    {线程入口函数} 
  30.  
    function  MyThreadFun(p: Pointer): DWORD;  stdcall
  31.  
    begin 
  32.  
      Form1.FormProc;  {调用 TForm1 类的方法} 
  33.  
      Result :=  99;    {这个返回值将成为线程的退出代码, 99 是我随意给的数字} 
  34.  
    end
  35.  
     
  36.  
    {TForm1 的方法, 本例中是给线程的入口函数调用的} 
  37.  
    procedure  TForm1.FormProc; 
  38.  
    var 
  39.  
      i: Integer; 
  40.  
    begin 
  41.  
       for i :=  0  to  200000  do 
  42.  
       begin 
  43.  
         with Form1.Canvas  do  begin 
  44.  
          Lock; 
  45.  
          TextOut( 1010, IntToStr(i)); 
  46.  
          Unlock; 
  47.  
         end
  48.  
       end
  49.  
    end
  50.  
     
  51.  
    {建立并执行线程} 
  52.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  53.  
    var 
  54.  
      ID: DWORD; 
  55.  
    begin 
  56.  
      hThread := CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  57.  
    end
  58.  
     
  59.  
    {获取线程的退出代码, 并判断线程是否退出} 
  60.  
    procedure  TForm1.Button2Click(Sender: TObject); 
  61.  
    var 
  62.  
      ExitCode: DWORD; 
  63.  
    begin 
  64.  
      GetExitCodeThread(hThread, ExitCode); 
  65.  
     
  66.  
       if hThread =  0  then 
  67.  
       begin 
  68.  
        Text :=  '线程还未启动'
  69.  
         Exit
  70.  
       end
  71.  
     
  72.  
       if ExitCode = STILL_ACTIVE  then 
  73.  
        Text := Format( '线程退出代码是: %d, 表示线程还未退出', [ExitCode]) 
  74.  
       else 
  75.  
        Text := Format( '线程已退出, 退出代码是: %d', [ExitCode]); 
  76.  
    end
  77.  
     
  78.  
    end.
㈤、堆栈大小
  1.  
    function  CreateThread
  2.  
      lpThreadAttributes: Pointer; 
  3.  
      dwStackSize: DWORD;   {堆栈大小}  
  4.  
      lpStartAddress: TFNThreadStartRoutine;  
  5.  
      lpParameter: Pointer;  
  6.  
      dwCreationFlags: DWORD; 
  7.  
       var  lpThreadId: DWORD 
  8.  
    ): 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 效果图:

  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.  
         procedure  Button1Click(Sender: TObject); 
  13.  
       end
  14.  
     
  15.  
    var 
  16.  
      Form1: TForm1; 
  17.  
     
  18.  
    implementation 
  19.  
     
  20.  
    {$R *.dfm} 
  21.  
     
  22.  
    //var num: Integer;     {全局变量}  
  23.  
    threadvar num: Integer;  {支持多线程的全局变量} 
  24.  
     
  25.  
    function  MyThreadFun(p: Pointer): DWORD;  stdcall
  26.  
    var 
  27.  
      py: Integer; 
  28.  
    begin 
  29.  
      py := Integer(p); 
  30.  
       while True  do 
  31.  
       begin 
  32.  
        Inc(num); 
  33.  
         with Form1.Canvas  do  begin 
  34.  
          Lock; 
  35.  
          TextOut( 20, py, IntToStr(num)); 
  36.  
          Unlock; 
  37.  
         end
  38.  
        Sleep( 1000);  {然线程挂起 1 秒钟再继续} 
  39.  
       end
  40.  
    end
  41.  
     
  42.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  43.  
    var 
  44.  
      ID: DWORD; 
  45.  
    begin 
  46.  
       {借入口函数的参数传递了一个坐标点中的 Y 值, 以让各线程把结果输出在不同位置} 
  47.  
      CreateThread( nil0, @MyThreadFun, Ptr( 20),  0, ID); 
  48.  
      CreateThread( nil0, @MyThreadFun, Ptr( 40),  0, ID); 
  49.  
      CreateThread( nil0, @MyThreadFun, Ptr( 60),  0, ID); 
  50.  
    end
  51.  
     
  52.  
    end.
㈥、安全设置
  1.  
    function  CreateThread
  2.  
      lpThreadAttributes: Pointer;  {安全设置}  
  3.  
      dwStackSize: DWORD; 
  4.  
      lpStartAddress: TFNThreadStartRoutine;  
  5.  
      lpParameter: Pointer;  
  6.  
      dwCreationFlags: DWORD; 
  7.  
       var  lpThreadId: DWORD 
  8.  
    ): THandle;  stdcall;
CreateThread 的第一个参数 lpThreadAttributes 是指向 TSecurityAttributes 结构的指针, 一般都是置为 nil, 这表示没有访问限制; 该结构的定义是:
  1.  
    //TSecurityAttributes(又名: SECURITY_ATTRIBUTES、_SECURITY_ATTRIBUTES)  
  2.  
    _SECURITY_ATTRIBUTES =  record 
  3.  
      nLength: DWORD;                 {结构大小} 
  4.  
      lpSecurityDescriptor: Pointer;  {默认 nil; 这是另一个结构 TSecurityDescriptor 的指针} 
  5.  
      bInheritHandle: BOOL;           {默认 False, 表示不可继承} 
  6.  
    end
  7.  
     
  8.  
    //TSecurityDescriptor(又名: SECURITY_DESCRIPTOR、_SECURITY_DESCRIPTOR)  
  9.  
    _SECURITY_DESCRIPTOR =  record 
  10.  
      Revision: Byte; 
  11.  
      Sbz1: Byte; 
  12.  
      Control: SECURITY_DESCRIPTOR_CONTROL; 
  13.  
      Owner: PSID; 
  14.  
      Group: PSID; 
  15.  
      Sacl: PACL; 
  16.  
      Dacl: PACL; 
  17.  
    end;
够复杂的, 但我们在多线程编程时不需要去设置它们, 大都是使用默认设置(也就是赋值为 nil).

我觉得有必要在此刻了解的是: 建立系统内核对象时一般都有这个属性(TSecurityAttributes);
在接下来多线程的课题中要使用一些内核对象, 不如先盘点一下, 到时碰到这个属性时给个 nil 即可, 不必再费神.
  1.  
    {建立事件} 
  2.  
    function  CreateEvent
  3.  
      lpEventAttributes: PSecurityAttributes;  {!}  
  4.  
      bManualReset: BOOL; 
  5.  
      bInitialState: BOOL; 
  6.  
      lpName: PWideChar 
  7.  
    ): THandle;  stdcall
  8.  
     
  9.  
    {建立互斥} 
  10.  
    function  CreateMutex
  11.  
      lpMutexAttributes: PSecurityAttributes;  {!}  
  12.  
      bInitialOwner: BOOL; 
  13.  
      lpName: PWideChar 
  14.  
    ): THandle;  stdcall
  15.  
     
  16.  
    {建立信号} 
  17.  
    function  CreateSemaphore
  18.  
      lpSemaphoreAttributes: PSecurityAttributes;  {!}  
  19.  
      lInitialCount: Longint; 
  20.  
      lMaximumCount: Longint; 
  21.  
      lpName: PWideChar 
  22.  
    ): THandle;  stdcall
  23.  
     
  24.  
    {建立等待计时器} 
  25.  
    function  CreateWaitableTimer
  26.  
      lpTimerAttributes: PSecurityAttributes;  {!}  
  27.  
      bManualReset: BOOL; 
  28.  
      lpTimerName: PWideChar 
  29.  
    ): THandle;  stdcall
上面的四个系统内核对象(事件、互斥、信号、计时器)都是线程同步的手段, 从这也能看出处理线程同步的复杂性; 不过这还不是全部, Windows Vista 开始又增加了 Condition variables(条件变量)、Slim Reader-Writer Locks(读写锁)等同步手段.

不过最简单、最轻便(速度最快)的同步手段还是 CriticalSection(临界区), 但它不属于系统内核对象, 当然也就没有句柄、没有 TSecurityAttributes 这个安全属性, 这也导致它不能跨进程使用; 不过写多线程时一般不用跨进程, 所以 CriticalSection 应该是最常用的同步手段.

二、临界区。
先看一段程序, 代码文件:
  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.  
        ListBox1: TListBox; 
  12.  
        Button1: TButton; 
  13.  
         procedure  FormCreate(Sender: TObject); 
  14.  
         procedure  Button1Click(Sender: TObject); 
  15.  
       end
  16.  
     
  17.  
    var 
  18.  
      Form1: TForm1; 
  19.  
     
  20.  
    implementation 
  21.  
     
  22.  
    {$R *.dfm} 
  23.  
     
  24.  
    function  MyThreadFun(p: Pointer): DWORD;  stdcall
  25.  
    var 
  26.  
      i: Integer; 
  27.  
    begin 
  28.  
       for i :=  0  to  99  do Form1.ListBox1.Items.Add(IntToStr(i)); 
  29.  
      Result :=  0
  30.  
    end
  31.  
     
  32.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  33.  
    var 
  34.  
      ID: DWORD; 
  35.  
    begin 
  36.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  37.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  38.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  39.  
    end
  40.  
     
  41.  
    procedure  TForm1.FormCreate(Sender: TObject); 
  42.  
    begin 
  43.  
      ListBox1.Align := alLeft; 
  44.  
    end
  45.  
     
  46.  
    end.
在这段程序中, 有三个线程几乎是同时建立, 向窗体中的 ListBox1 中写数据, 最后写出的结果是这样的:

能不能让它们别打架, 一个完了另一个再来? 这就要用到多线程的同步技术.
前面说过, 最简单的同步手段就是 "临界区".

先说这个 "同步"(Synchronize), 首先这个名字起的不好, 我们好像需要的是 "异步"; 其实异步也不准确...
管它叫什么名字呢, 它的目的就是保证不冲突、有次序、都发生.

"临界区"(CriticalSection): 当把一段代码放入一个临界区, 线程执行到临界区时就独占了, 让其他也要执行此代码的线程先等等; 这和前面用的 Lock 和 UnLock 差不多; 使用格式如下:
  1.  
    var CS: TRTLCriticalSection;    {声明一个 TRTLCriticalSection 结构类型变量; 它应该是全局的} 
  2.  
    InitializeCriticalSection(CS);  {初始化} 
  3.  
    EnterCriticalSection(CS);       {开始: 轮到我了其他线程走开} 
  4.  
    LeaveCriticalSection(CS);       {结束: 其他线程可以来了} 
  5.  
    DeleteCriticalSection(CS);      {删除: 注意不能过早删除} 
  6.  
     
  7.  
    //也可用 TryEnterCriticalSection 替代 EnterCriticalSection.
用上临界区, 重写上面的代码, 运行效果图:

  1.  
    //用临界区重写后的代码文件:  
  2.  
    unit Unit1; 
  3.  
     
  4.  
    interface 
  5.  
     
  6.  
    uses 
  7.  
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  8.  
      Dialogs, StdCtrls; 
  9.  
     
  10.  
    type 
  11.  
       TForm1 =  class(TForm) 
  12.  
        ListBox1: TListBox; 
  13.  
        Button1: TButton; 
  14.  
         procedure  FormCreate(Sender: TObject); 
  15.  
         procedure  FormDestroy(Sender: TObject); 
  16.  
         procedure  Button1Click(Sender: TObject); 
  17.  
       end
  18.  
     
  19.  
    var 
  20.  
      Form1: TForm1; 
  21.  
     
  22.  
    implementation 
  23.  
     
  24.  
    {$R *.dfm} 
  25.  
     
  26.  
    var 
  27.  
      CS: TRTLCriticalSection; 
  28.  
     
  29.  
    function  MyThreadFun(p: Pointer): DWORD;  stdcall
  30.  
    var 
  31.  
      i: Integer; 
  32.  
    begin 
  33.  
      EnterCriticalSection(CS); 
  34.  
       for i :=  0  to  99  do Form1.ListBox1.Items.Add(IntToStr(i)); 
  35.  
      LeaveCriticalSection(CS); 
  36.  
      Result :=  0
  37.  
    end
  38.  
     
  39.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  40.  
    var 
  41.  
      ID: DWORD; 
  42.  
    begin 
  43.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  44.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  45.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  46.  
    end
  47.  
     
  48.  
    procedure  TForm1.FormCreate(Sender: TObject); 
  49.  
    begin 
  50.  
      ListBox1.Align := alLeft; 
  51.  
      InitializeCriticalSection(CS); 
  52.  
    end
  53.  
     
  54.  
    procedure  TForm1.FormDestroy(Sender: TObject); 
  55.  
    begin 
  56.  
      DeleteCriticalSection(CS); 
  57.  
    end
  58.  
     
  59.  
    end.
Delphi 在 SyncObjs 单元给封装了一个 TCriticalSection 类, 用法差不多, 代码如下:
  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.  
        ListBox1: TListBox; 
  12.  
        Button1: TButton; 
  13.  
         procedure  FormCreate(Sender: TObject); 
  14.  
         procedure  FormDestroy(Sender: TObject); 
  15.  
         procedure  Button1Click(Sender: TObject); 
  16.  
       end
  17.  
     
  18.  
    var 
  19.  
      Form1: TForm1; 
  20.  
     
  21.  
    implementation 
  22.  
     
  23.  
    {$R *.dfm} 
  24.  
     
  25.  
    uses SyncObjs; 
  26.  
     
  27.  
    var 
  28.  
      CS: TCriticalSection; 
  29.  
     
  30.  
    function  MyThreadFun(p: Pointer): DWORD;  stdcall
  31.  
    var 
  32.  
      i: Integer; 
  33.  
    begin 
  34.  
      CS.Enter; 
  35.  
       for i :=  0  to  99  do Form1.ListBox1.Items.Add(IntToStr(i)); 
  36.  
      CS.Leave; 
  37.  
      Result :=  0
  38.  
    end
  39.  
     
  40.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  41.  
    var 
  42.  
      ID: DWORD; 
  43.  
    begin 
  44.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  45.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  46.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  47.  
    end
  48.  
     
  49.  
    procedure  TForm1.FormCreate(Sender: TObject); 
  50.  
    begin 
  51.  
      ListBox1.Align := alLeft; 
  52.  
      CS := TCriticalSection.Create; 
  53.  
    end
  54.  
     
  55.  
    procedure  TForm1.FormDestroy(Sender: TObject); 
  56.  
    begin 
  57.  
      CS.Free; 
  58.  
    end
  59.  
     
  60.  
    end.
三、等待函数 WaitForSingleObject
一下子跳到等待函数 WaitForSingleObject, 是因为下面的 Mutex、Semaphore、Event、WaitableTimer 等同步手段都要使用这个函数; 不过等待函数可不止 WaitForSingleObject 它一个, 但它最简单.
  1.  
    function  WaitForSingleObject
  2.  
      hHandle: THandle;       {要等待的对象句柄}  
  3.  
      dwMilliseconds: DWORD   {等待的时间, 单位是毫秒}  
  4.  
    ): DWORD;  stdcall;        {返回值如下:} 
  5.  
     
  6.  
    WAIT_OBJECT_0   {等着了, 本例中是: 等的那个进程终于结束了} 
  7.  
    WAIT_TIMEOUT    {等过了点(你指定的时间), 也没等着} 
  8.  
    WAIT_ABANDONED  {好不容易等着了, 但人家还是不让咱执行; 这一般是互斥对象} 
  9.  
     
  10.  
    //WaitForSingleObject 的第二个参数一般给常数值 INFINITE, 表示一直等下去, 死等.  

WaitForSingleObject 等待什么? 在多线程里就是等待另一个线程的结束, 快来执行自己的代码; 不过它可以等待的对象可不止线程; 这里先来一个等待另一个进程结束的例子, 运行效果图:

  1.  
    //WaitForSingleObject的示例代码文件:  
  2.  
     
  3.  
    unit Unit1; 
  4.  
     
  5.  
    interface 
  6.  
     
  7.  
    uses 
  8.  
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  9.  
      Dialogs, StdCtrls; 
  10.  
     
  11.  
    type 
  12.  
       TForm1 =  class(TForm) 
  13.  
        Button1: TButton; 
  14.  
         procedure  Button1Click(Sender: TObject); 
  15.  
       end
  16.  
     
  17.  
    var 
  18.  
      Form1: TForm1; 
  19.  
     
  20.  
    implementation 
  21.  
     
  22.  
    {$R *.dfm} 
  23.  
     
  24.  
    var 
  25.  
      hProcess: THandle;  {进程句柄} 
  26.  
     
  27.  
    {等待一个指定句柄的进程什么时候结束} 
  28.  
    function  MyThreadFun(p: Pointer): DWORD;  stdcall
  29.  
    begin 
  30.  
       if WaitForSingleObject(hProcess, INFINITE) = WAIT_OBJECT_0  then 
  31.  
        Form1.Text := Format( '进程 %d 已关闭', [hProcess]); 
  32.  
      Result :=  0
  33.  
    end
  34.  
     
  35.  
    {启动一个进程, 并建立新线程等待它的结束} 
  36.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  37.  
    var 
  38.  
      pInfo: TProcessInformation; 
  39.  
      sInfo: TStartupInfo; 
  40.  
      Path:  array[ 0..MAX_PATH -1of Char; 
  41.  
      ThreadID: DWORD; 
  42.  
    begin 
  43.  
       {先获取记事本的路径} 
  44.  
      GetSystemDirectory(Path, MAX_PATH); 
  45.  
      StrCat(Path,  '\notepad.exe'); 
  46.  
     
  47.  
       {用 CreateProcess 打开记事本并获取其进程句柄, 然后建立线程监视} 
  48.  
      FillChar(sInfo, SizeOf(sInfo),  0); 
  49.  
       if CreateProcess(Path,  nilnilnil, False,  0nilnil, sInfo, pInfo)  then 
  50.  
       begin 
  51.  
        hProcess := pInfo.hProcess;                            {获取进程句柄} 
  52.  
        Text := Format( '进程 %d 已启动', [hProcess]);  
  53.  
        CreateThread( nil0, @MyThreadFun,  nil0, ThreadID);  {建立线程监视} 
  54.  
       end
  55.  
    end
  56.  
     
  57.  
    end.
  1.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  2.  
    var 
  3.  
      i: Integer; 
  4.  
    begin 
  5.  
       for i :=  0  to  500000  do 
  6.  
       begin 
  7.  
        Canvas.TextOut( 1010, IntToStr(i)); 
  8.  
       end
  9.  
    end

上面程序运行时, 我们的窗体基本是 "死" 的, 可以在你在程序运行期间拖动窗体试试...

Delphi 为我们提供了一个简单的办法(Application.ProcessMessages)来解决这个问题:
  1.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  2.  
    var 
  3.  
      i: Integer; 
  4.  
    begin 
  5.  
       for i :=  0  to  500000  do 
  6.  
       begin 
  7.  
        Canvas.TextOut( 1010, IntToStr(i)); 
  8.  
        Application.ProcessMessages; 
  9.  
       end
  10.  
    end

这个 Application.ProcessMessages; 一般用在比较费时的循环中, 它会检查并先处理消息队列中的其他消息.

但这算不上多线程, 譬如: 运行中你拖动窗体, 循环会暂停下来...

在使用多线程以前, 让我们先简单修改一下程序:
  1.  
    function  MyFun: Integer; 
  2.  
    var 
  3.  
      i: Integer; 
  4.  
    begin 
  5.  
       for i :=  0  to  500000  do 
  6.  
       begin 
  7.  
        Form1.Canvas.Lock; 
  8.  
        Form1.Canvas.TextOut( 1010, IntToStr(i)); 
  9.  
        Form1.Canvas.Unlock; 
  10.  
       end
  11.  
      Result :=  0
  12.  
    end
  13.  
     
  14.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  15.  
    begin 
  16.  
      MyFun; 
  17.  
    end

细数上面程序的变化:
1、首先这还不是多线程的, 也会让窗体假 "死" 一会;
2、把执行代码写在了一个函数里, 但这个函数不属于 TForm1 的方法, 所以使用 Canvas 是必须冠以名称(Form1);
3、既然是个函数, (不管是否必要)都应该有返回值;
4、使用了 500001 次 Lock 和 Unlock.

Canvas.Lock 好比在说: Canvas(绘图表面)正忙着呢, 其他想用 Canvas 的等会;
Canvas.Unlock : 用完了, 解锁!

在 Canvas 中使用 Lock 和 Unlock 是个好习惯, 在不使用多线程的情况下这无所谓, 但保不准哪天程序会扩展为多线程的; 我们现在学习多线程, 当然应该用.

在 Delphi 中使用多线程有两种方法: 调用 API、使用 TThread 类; 使用 API 的代码更简单.
  1.  
    function  MyFun(p: Pointer): Integer;  stdcall
  2.  
    var 
  3.  
      i: Integer; 
  4.  
    begin 
  5.  
       for i :=  0  to  500000  do 
  6.  
       begin 
  7.  
        Form1.Canvas.Lock; 
  8.  
        Form1.Canvas.TextOut( 1010, IntToStr(i)); 
  9.  
        Form1.Canvas.Unlock; 
  10.  
       end
  11.  
      Result :=  0
  12.  
    end
  13.  
     
  14.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  15.  
    var 
  16.  
      ID: THandle; 
  17.  
    begin 
  18.  
      CreateThread( nil0, @MyFun,  nil0, ID); 
  19.  
    end

代码分析:
CreateThread 一个线程后, 算上原来的主线程, 这样程序就有两个线程、是标准的多线程了;
CreateThread 第三个参数是函数指针, 新线程建立后将立即执行该函数, 函数执行完毕, 系统将销毁此线程从而结束多线程的故事.

CreateThread 要使用的函数是系统级别的, 不能是某个类(譬如: TForm1)的方法, 并且有严格的格式(参数、返回值)要求, 不管你暂时是不是需要都必须按格式来;
因为是系统级调用, 还要缀上 stdcall, stdcall 是协调参数顺序的, 虽然这里只有一个参数没有顺序可言, 但这是使用系统函数的惯例.

CreateThread 还需要一个 var 参数来接受新建线程的 ID, 尽管暂时没用, 但这也是格式; 其他参数以后再说吧.

这样一个最简单的多线程程序就出来了, 咱们再用 TThread 类实现一次
  1.  
    type 
  2.  
       TMyThread =  class(TThread) 
  3.  
       protected 
  4.  
         procedure  Execute;  override
  5.  
       end
  6.  
     
  7.  
    procedure  TMyThread.Execute; 
  8.  
    var 
  9.  
      i: Integer; 
  10.  
    begin 
  11.  
      FreeOnTerminate := True;  {这可以让线程执行完毕后随即释放} 
  12.  
       for i :=  0  to  500000  do 
  13.  
       begin 
  14.  
        Form1.Canvas.Lock; 
  15.  
        Form1.Canvas.TextOut( 1010, IntToStr(i)); 
  16.  
        Form1.Canvas.Unlock; 
  17.  
       end
  18.  
    end
  19.  
     
  20.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  21.  
    begin 
  22.  
      TMyThread.Create(False); 
  23.  
    end
  24.  
     
TThread 类有一个抽象方法(Execute), 因而是个抽象类, 抽象类只能继承使用, 上面是继承为 TMyThread.

继承 TThread 主要就是实现抽象方法 Execute(把我们的代码写在里面), 等我们的 TMyThread 实例化后, 首先就会执行 Execute 方法中的代码.

按常规我们一般这样去实例化:
  1.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  2.  
    var 
  3.  
      MyThread: TMyThread; 
  4.  
    begin 
  5.  
      MyThread := TMyThread.Create(False); 
  6.  
    end
因为 MyThread 变量在这里毫无用处(并且编译器还有提示), 所以不如直接写做 TMyThread.Create(False);

我们还可以轻松解决一个问题, 如果: TMyThread.Create(True) ?
这样线程建立后就不会立即调用 Execute, 可以在需要的时候再用 Resume 方法执行线程, 譬如:
  1.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  2.  
    var 
  3.  
      MyThread: TMyThread; 
  4.  
    begin 
  5.  
      MyThread := TMyThread.Create(True); 
  6.  
      MyThread.Resume; 
  7.  
    end
  8.  
     
  9.  
    //可简化为:  
  10.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  11.  
    begin 
  12.  
       with TMyThread.Create(True)  do Resume; 
  13.  
    end

一、入门
㈠、
  1.  
    function  CreateThread
  2.  
      lpThreadAttributes: Pointer;            {安全设置}  
  3.  
      dwStackSize: DWORD;                     {堆栈大小}  
  4.  
      lpStartAddress: TFNThreadStartRoutine;  {入口函数}  
  5.  
      lpParameter: Pointer;                   {函数参数}  
  6.  
      dwCreationFlags: DWORD;                 {启动选项}  
  7.  
       var  lpThreadId: DWORD                   {输出线程 ID }  
  8.  
    ): THandle;  stdcall;                      {返回线程句柄} 

在 Windows 上建立一个线程, 离不开 CreateThread 函数;
TThread.Create 就是先调用了 BeginThread (Delphi 自定义的), BeginThread 又调用的 CreateThread.
既然有建立, 就该有释放, CreateThread 对应的释放函数是: ExitThread, 譬如下面代码:
  1.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  2.  
    begin 
  3.  
      ExitThread( 0);  {此句即可退出当前程序, 但不建议这样使用} 
  4.  
    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) 的定义:
  1.  
    PContext = ^TContext; 
  2.  
    _CONTEXT =  record 
  3.  
      ContextFlags: DWORD; 
  4.  
      Dr0: DWORD; 
  5.  
      Dr1: DWORD; 
  6.  
      Dr2: DWORD; 
  7.  
      Dr3: DWORD; 
  8.  
      Dr6: DWORD; 
  9.  
      Dr7: DWORD; 
  10.  
      FloatSave: TFloatingSaveArea; 
  11.  
      SegGs: DWORD; 
  12.  
      SegFs: DWORD; 
  13.  
      SegEs: DWORD; 
  14.  
      SegDs: DWORD; 
  15.  
      Edi: DWORD; 
  16.  
      Esi: DWORD; 
  17.  
      Ebx: DWORD; 
  18.  
      Edx: DWORD; 
  19.  
      Ecx: DWORD; 
  20.  
      Eax: DWORD; 
  21.  
      Ebp: DWORD; 
  22.  
      Eip: DWORD; 
  23.  
      SegCs: DWORD; 
  24.  
      EFlags: DWORD; 
  25.  
      Esp: DWORD; 
  26.  
      SegSs: DWORD; 
  27.  
    end

CreateThread 的最后一个参数是 "线程的 ID";
既然可以返回句柄, 为什么还要输出这个 ID? 现在我知道的是:
1、线程的 ID 是唯一的; 而句柄可能不只一个, 譬如可以用 GetCurrentThread 获取一个伪句柄、可以用 DuplicateHandle 复制一个句柄等等.
2、ID 比句柄更轻便.

在主线程中 GetCurrentThreadId、MainThreadID、MainInstance 获取的都是主线程的 ID.
㈡、启动选项
  1.  
    function  CreateThread
  2.  
      lpThreadAttributes: Pointer; 
  3.  
      dwStackSize: DWORD; 
  4.  
      lpStartAddress: TFNThreadStartRoutine; 
  5.  
      lpParameter: Pointer; 
  6.  
      dwCreationFlags: DWORD;  {启动选项}  
  7.  
       var  lpThreadId: DWORD 
  8.  
    ): THandle;  stdcall;
CreateThread 的倒数第二个参数 dwCreationFlags(启动选项) 有两个可选值:
0: 线程建立后立即执行入口函数;
CREATE_SUSPENDED: 线程建立后会挂起等待.

可用 ResumeThread 函数是恢复线程的运行; 可用 SuspendThread 再次挂起线程.
这两个函数的参数都是线程句柄, 返回值是执行前的挂起计数.

什么是挂起计数?
SuspendThread 会给这个数 +1; ResumeThread 会给这个数 -1; 但这个数最小是 0.
当这个数 = 0 时, 线程会运行; > 0 时会挂起.
如果被 SuspendThread 多次, 同样需要 ResumeThread 多次才能恢复线程的运行.

在下面的例子中, 有新线程不断给一个全局变量赋随机值;
同时窗体上的 Timer 控件每隔 1/10 秒就把这个变量写在窗体标题;
在这个过程中演示了 ResumeThread、SuspendThread 两个函数.

  1.  
    //上面图片中演示的代码。  
  2.  
    unit Unit1; 
  3.  
     
  4.  
    interface 
  5.  
     
  6.  
    uses 
  7.  
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  8.  
      Dialogs, StdCtrls, ExtCtrls; 
  9.  
     
  10.  
    type 
  11.  
       TForm1 =  class(TForm) 
  12.  
        Button1: TButton; 
  13.  
        Button2: TButton; 
  14.  
        Button3: TButton; 
  15.  
        Timer1: TTimer; 
  16.  
         procedure  Button1Click(Sender: TObject); 
  17.  
         procedure  Button2Click(Sender: TObject); 
  18.  
         procedure  Button3Click(Sender: TObject); 
  19.  
         procedure  FormCreate(Sender: TObject); 
  20.  
         procedure  Timer1Timer(Sender: TObject); 
  21.  
       end
  22.  
     
  23.  
    var 
  24.  
      Form1: TForm1; 
  25.  
     
  26.  
    implementation 
  27.  
     
  28.  
    {$R *.dfm} 
  29.  
     
  30.  
    var 
  31.  
      hThread: THandle;  {线程句柄} 
  32.  
      num: Integer;      {全局变量, 用于记录随机数} 
  33.  
     
  34.  
    {线程入口函数} 
  35.  
    function  MyThreadFun(p: Pointer): Integer;  stdcall
  36.  
    begin 
  37.  
       while True  do  {假如线程不挂起, 这个循环将一直循环下去} 
  38.  
       begin 
  39.  
        num := Random( 100); 
  40.  
       end
  41.  
      Result :=  0
  42.  
    end
  43.  
     
  44.  
    {建立并挂起线程} 
  45.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  46.  
    var 
  47.  
      ID: DWORD; 
  48.  
    begin 
  49.  
      hThread := CreateThread( nil0, @MyThreadFun,  nil, CREATE_SUSPENDED, ID); 
  50.  
      Button1.Enabled := False; 
  51.  
    end
  52.  
     
  53.  
    {唤醒并继续线程} 
  54.  
    procedure  TForm1.Button2Click(Sender: TObject); 
  55.  
    begin 
  56.  
      ResumeThread(hThread); 
  57.  
    end
  58.  
     
  59.  
    {挂起线程} 
  60.  
    procedure  TForm1.Button3Click(Sender: TObject); 
  61.  
    begin 
  62.  
      SuspendThread(hThread); 
  63.  
    end
  64.  
     
  65.  
    procedure  TForm1.FormCreate(Sender: TObject); 
  66.  
    begin 
  67.  
      Timer1.Interval :=  100
  68.  
    end
  69.  
     
  70.  
    procedure  TForm1.Timer1Timer(Sender: TObject); 
  71.  
    begin 
  72.  
      Text := IntToStr(num); 
  73.  
    end
  74.  
     
  75.  
    end.
㈢、入口函数的参数
  1.  
    function  CreateThread
  2.  
      lpThreadAttributes: Pointer; 
  3.  
      dwStackSize: DWORD; 
  4.  
      lpStartAddress: TFNThreadStartRoutine; 
  5.  
      lpParameter: Pointer;   {入口函数的参数}  
  6.  
      dwCreationFlags: DWORD; 
  7.  
       var  lpThreadId: DWORD 
  8.  
    ): THandle;  stdcall;
线程入口函数的参数是个无类型指针(Pointer), 用它可以指定任何数据; 本例是把鼠标点击窗体的坐标传递给线程的入口函数, 每次点击窗体都会创建一个线程.

运行效果图:

  1.  
    //上面演示的代码  
  2.  
    unit Unit1; 
  3.  
     
  4.  
    interface 
  5.  
     
  6.  
    uses 
  7.  
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  8.  
      Dialogs; 
  9.  
     
  10.  
    type 
  11.  
       TForm1 =  class(TForm) 
  12.  
         procedure  FormMouseUp(Sender: TObject; Button: TMouseButton; 
  13.  
          Shift: TShiftState; X, Y: Integer)
  14.  
       end
  15.  
     
  16.  
    var 
  17.  
      Form1: TForm1; 
  18.  
     
  19.  
    implementation 
  20.  
     
  21.  
    {$R *.dfm} 
  22.  
     
  23.  
    var 
  24.  
      pt: TPoint;  {这个坐标点将会已指针的方式传递给线程, 它应该是全局的} 
  25.  
     
  26.  
    function  MyThreadFun(p: Pointer): Integer;  stdcall
  27.  
    var 
  28.  
      i: Integer; 
  29.  
      pt2: TPoint;        {因为指针参数给的点随时都在变, 需用线程的局部变量存起来} 
  30.  
    begin 
  31.  
      pt2 := PPoint(p)^;  {转换} 
  32.  
       for i :=  0  to  1000000  do 
  33.  
       begin 
  34.  
         with Form1.Canvas  do  begin 
  35.  
          Lock; 
  36.  
          TextOut(pt2.X, pt2.Y, IntToStr(i)); 
  37.  
          Unlock; 
  38.  
         end
  39.  
       end
  40.  
      Result :=  0
  41.  
    end
  42.  
     
  43.  
    procedure  TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; 
  44.  
      Shift: TShiftState; X, Y: Integer)
  45.  
    var 
  46.  
      ID: DWORD; 
  47.  
    begin 
  48.  
      pt := Point(X, Y); 
  49.  
      CreateThread( nil0, @MyThreadFun, @pt,  0, ID); 
  50.  
       {下面这种写法更好理解, 其实不必, 因为 PPoint 会自动转换为 Pointer 的} 
  51.  
       //CreateThread(nil, 0, @MyThreadFun, Pointer(@pt), 0, ID);  
  52.  
    end
  53.  
     
  54.  
    end.

这个例子还有不严谨的地方: 当一个线程 Lock 窗体的 Canvas 时, 其他线程在等待; 线程在等待时, 其中的计数也还在增加. 这也就是说: 现在并没有去处理线程的同步; 同步是多线程中最重要的课题, 快到了.

另外有个小技巧: 线程函数的参数是个 32 位(4个字节)的指针, 仅就本例来讲, 可以让它的 "高16位" 和 "低16位" 分别携带 X 和 Y; 这样就不需要哪个全局的 pt 变量了.
其实在 Windows 的消息中就是这样传递坐标的, 在 Windows 的消息中一般高字节是 Y、低字节是 X; 咱们这么来吧, 这样还可以使用给消息准备的一些方便的函数.

重写本例代码(当然运行效果和窗体文件都是一样的):
  1.  
    unit Unit1; 
  2.  
     
  3.  
    interface 
  4.  
     
  5.  
    uses 
  6.  
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  7.  
      Dialogs; 
  8.  
     
  9.  
    type 
  10.  
       TForm1 =  class(TForm) 
  11.  
         procedure  FormMouseUp(Sender: TObject; Button: TMouseButton; 
  12.  
          Shift: TShiftState; X, Y: Integer)
  13.  
       end
  14.  
     
  15.  
    var 
  16.  
      Form1: TForm1; 
  17.  
     
  18.  
    implementation 
  19.  
     
  20.  
    {$R *.dfm} 
  21.  
     
  22.  
    function  MyThreadFun(p: Pointer): Integer;  stdcall
  23.  
    var 
  24.  
      i: Integer; 
  25.  
      x,y: Word; 
  26.  
    begin 
  27.  
      x := LoWord(Integer(p)); 
  28.  
      y := HiWord(Integer(p)); 
  29.  
       {如果不使用 LoWord、HiWord 函数可以像下面这样: } 
  30.  
       //x := Integer(p);  
  31.  
       //y := Integer(p) shr 16;  
  32.  
       for i :=  0  to  1000000  do 
  33.  
       begin 
  34.  
         with Form1.Canvas  do  begin 
  35.  
          Lock; 
  36.  
          TextOut(x, y, IntToStr(i)); 
  37.  
          Unlock; 
  38.  
         end
  39.  
       end
  40.  
      Result :=  0
  41.  
    end
  42.  
     
  43.  
    procedure  TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; 
  44.  
      Shift: TShiftState; X, Y: Integer)
  45.  
    var 
  46.  
      ID: DWORD; 
  47.  
      num: Integer; 
  48.  
    begin 
  49.  
      num := MakeLong(X, Y); 
  50.  
       {如果不使用 MekeLong、MakeWParam、MakeLParam、MakeResult 等函数, 可以像下面这样: } 
  51.  
       //num := Y shl 16 + X;  
  52.  
      CreateThread( nil0, @MyThreadFun, Ptr(num),  0, ID); 
  53.  
       {上面的 Ptr 是专门将一个数字转换为指针的函数, 当然也可以这样: } 
  54.  
       //CreateThread(nil, 0, @MyThreadFun, Pointer(num), 0, ID);  
  55.  
    end
  56.  
     
  57.  
    end.
㈣、入口函数的指针
  1.  
    function  CreateThread
  2.  
      lpThreadAttributes: Pointer; 
  3.  
      dwStackSize: DWORD; 
  4.  
      lpStartAddress: TFNThreadStartRoutine;  {入口函数的指针}  
  5.  
      lpParameter: Pointer;  
  6.  
      dwCreationFlags: DWORD; 
  7.  
       var  lpThreadId: DWORD 
  8.  
    ): THandle;  stdcall;


到了入口函数了, 学到这个地方, 我查了一个入口函数的标准定义, 这个函数的标准返回值应该是 DWORD, 不过这函数在 Delphi 的 System 单元定义的是: TThreadFunc = function(Parameter: Pointer): Integer; 我以后会尽量使用 DWORD 做入口函数的返回值.

这个返回值有什么用呢?
等线程退出后, 我们用 GetExitCodeThread 函数获取的退出码就是这个返回值!

如果线程没有退出, GetExitCodeThread 获取的退出码将是一个常量 STILL_ACTIVE (259); 这样我们就可以通过退出码来判断线程是否已退出.

还有一个问题: 前面也提到过, 线程函数不能是某个类的方法! 假如我们非要线程去执行类中的一个方法能否实现呢?
尽管可以用 Addr(类名.方法名) 或 MethodAddress('published 区的方法名') 获取类中方法的地址, 但都不能当做线程的入口函数, 原因可能是因为类中的方法的地址是在实例化为对象时动态分配的.
后来换了个思路, 其实很简单: 在线程函数中再调用方法不就得了, 估计 TThread 也应该是这样.

下面的例子就尝试了用线程调用 TForm1 类中的方法, 并测试了退出码的相关问题.

  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.  
        Button2: TButton; 
  13.  
         procedure  Button1Click(Sender: TObject); 
  14.  
         procedure  Button2Click(Sender: TObject); 
  15.  
         private 
  16.  
           procedure  FormProc;  {准备给线程使用的方法} 
  17.  
       end
  18.  
     
  19.  
    var 
  20.  
      Form1: TForm1; 
  21.  
     
  22.  
    implementation 
  23.  
     
  24.  
    {$R *.dfm} 
  25.  
     
  26.  
    var 
  27.  
      hThread: THandle; 
  28.  
     
  29.  
    {线程入口函数} 
  30.  
    function  MyThreadFun(p: Pointer): DWORD;  stdcall
  31.  
    begin 
  32.  
      Form1.FormProc;  {调用 TForm1 类的方法} 
  33.  
      Result :=  99;    {这个返回值将成为线程的退出代码, 99 是我随意给的数字} 
  34.  
    end
  35.  
     
  36.  
    {TForm1 的方法, 本例中是给线程的入口函数调用的} 
  37.  
    procedure  TForm1.FormProc; 
  38.  
    var 
  39.  
      i: Integer; 
  40.  
    begin 
  41.  
       for i :=  0  to  200000  do 
  42.  
       begin 
  43.  
         with Form1.Canvas  do  begin 
  44.  
          Lock; 
  45.  
          TextOut( 1010, IntToStr(i)); 
  46.  
          Unlock; 
  47.  
         end
  48.  
       end
  49.  
    end
  50.  
     
  51.  
    {建立并执行线程} 
  52.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  53.  
    var 
  54.  
      ID: DWORD; 
  55.  
    begin 
  56.  
      hThread := CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  57.  
    end
  58.  
     
  59.  
    {获取线程的退出代码, 并判断线程是否退出} 
  60.  
    procedure  TForm1.Button2Click(Sender: TObject); 
  61.  
    var 
  62.  
      ExitCode: DWORD; 
  63.  
    begin 
  64.  
      GetExitCodeThread(hThread, ExitCode); 
  65.  
     
  66.  
       if hThread =  0  then 
  67.  
       begin 
  68.  
        Text :=  '线程还未启动'
  69.  
         Exit
  70.  
       end
  71.  
     
  72.  
       if ExitCode = STILL_ACTIVE  then 
  73.  
        Text := Format( '线程退出代码是: %d, 表示线程还未退出', [ExitCode]) 
  74.  
       else 
  75.  
        Text := Format( '线程已退出, 退出代码是: %d', [ExitCode]); 
  76.  
    end
  77.  
     
  78.  
    end.
㈤、堆栈大小
  1.  
    function  CreateThread
  2.  
      lpThreadAttributes: Pointer; 
  3.  
      dwStackSize: DWORD;   {堆栈大小}  
  4.  
      lpStartAddress: TFNThreadStartRoutine;  
  5.  
      lpParameter: Pointer;  
  6.  
      dwCreationFlags: DWORD; 
  7.  
       var  lpThreadId: DWORD 
  8.  
    ): 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 效果图:

  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.  
         procedure  Button1Click(Sender: TObject); 
  13.  
       end
  14.  
     
  15.  
    var 
  16.  
      Form1: TForm1; 
  17.  
     
  18.  
    implementation 
  19.  
     
  20.  
    {$R *.dfm} 
  21.  
     
  22.  
    //var num: Integer;     {全局变量}  
  23.  
    threadvar num: Integer;  {支持多线程的全局变量} 
  24.  
     
  25.  
    function  MyThreadFun(p: Pointer): DWORD;  stdcall
  26.  
    var 
  27.  
      py: Integer; 
  28.  
    begin 
  29.  
      py := Integer(p); 
  30.  
       while True  do 
  31.  
       begin 
  32.  
        Inc(num); 
  33.  
         with Form1.Canvas  do  begin 
  34.  
          Lock; 
  35.  
          TextOut( 20, py, IntToStr(num)); 
  36.  
          Unlock; 
  37.  
         end
  38.  
        Sleep( 1000);  {然线程挂起 1 秒钟再继续} 
  39.  
       end
  40.  
    end
  41.  
     
  42.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  43.  
    var 
  44.  
      ID: DWORD; 
  45.  
    begin 
  46.  
       {借入口函数的参数传递了一个坐标点中的 Y 值, 以让各线程把结果输出在不同位置} 
  47.  
      CreateThread( nil0, @MyThreadFun, Ptr( 20),  0, ID); 
  48.  
      CreateThread( nil0, @MyThreadFun, Ptr( 40),  0, ID); 
  49.  
      CreateThread( nil0, @MyThreadFun, Ptr( 60),  0, ID); 
  50.  
    end
  51.  
     
  52.  
    end.
㈥、安全设置
  1.  
    function  CreateThread
  2.  
      lpThreadAttributes: Pointer;  {安全设置}  
  3.  
      dwStackSize: DWORD; 
  4.  
      lpStartAddress: TFNThreadStartRoutine;  
  5.  
      lpParameter: Pointer;  
  6.  
      dwCreationFlags: DWORD; 
  7.  
       var  lpThreadId: DWORD 
  8.  
    ): THandle;  stdcall;
CreateThread 的第一个参数 lpThreadAttributes 是指向 TSecurityAttributes 结构的指针, 一般都是置为 nil, 这表示没有访问限制; 该结构的定义是:
  1.  
    //TSecurityAttributes(又名: SECURITY_ATTRIBUTES、_SECURITY_ATTRIBUTES)  
  2.  
    _SECURITY_ATTRIBUTES =  record 
  3.  
      nLength: DWORD;                 {结构大小} 
  4.  
      lpSecurityDescriptor: Pointer;  {默认 nil; 这是另一个结构 TSecurityDescriptor 的指针} 
  5.  
      bInheritHandle: BOOL;           {默认 False, 表示不可继承} 
  6.  
    end
  7.  
     
  8.  
    //TSecurityDescriptor(又名: SECURITY_DESCRIPTOR、_SECURITY_DESCRIPTOR)  
  9.  
    _SECURITY_DESCRIPTOR =  record 
  10.  
      Revision: Byte; 
  11.  
      Sbz1: Byte; 
  12.  
      Control: SECURITY_DESCRIPTOR_CONTROL; 
  13.  
      Owner: PSID; 
  14.  
      Group: PSID; 
  15.  
      Sacl: PACL; 
  16.  
      Dacl: PACL; 
  17.  
    end;
够复杂的, 但我们在多线程编程时不需要去设置它们, 大都是使用默认设置(也就是赋值为 nil).

我觉得有必要在此刻了解的是: 建立系统内核对象时一般都有这个属性(TSecurityAttributes);
在接下来多线程的课题中要使用一些内核对象, 不如先盘点一下, 到时碰到这个属性时给个 nil 即可, 不必再费神.
  1.  
    {建立事件} 
  2.  
    function  CreateEvent
  3.  
      lpEventAttributes: PSecurityAttributes;  {!}  
  4.  
      bManualReset: BOOL; 
  5.  
      bInitialState: BOOL; 
  6.  
      lpName: PWideChar 
  7.  
    ): THandle;  stdcall
  8.  
     
  9.  
    {建立互斥} 
  10.  
    function  CreateMutex
  11.  
      lpMutexAttributes: PSecurityAttributes;  {!}  
  12.  
      bInitialOwner: BOOL; 
  13.  
      lpName: PWideChar 
  14.  
    ): THandle;  stdcall
  15.  
     
  16.  
    {建立信号} 
  17.  
    function  CreateSemaphore
  18.  
      lpSemaphoreAttributes: PSecurityAttributes;  {!}  
  19.  
      lInitialCount: Longint; 
  20.  
      lMaximumCount: Longint; 
  21.  
      lpName: PWideChar 
  22.  
    ): THandle;  stdcall
  23.  
     
  24.  
    {建立等待计时器} 
  25.  
    function  CreateWaitableTimer
  26.  
      lpTimerAttributes: PSecurityAttributes;  {!}  
  27.  
      bManualReset: BOOL; 
  28.  
      lpTimerName: PWideChar 
  29.  
    ): THandle;  stdcall
上面的四个系统内核对象(事件、互斥、信号、计时器)都是线程同步的手段, 从这也能看出处理线程同步的复杂性; 不过这还不是全部, Windows Vista 开始又增加了 Condition variables(条件变量)、Slim Reader-Writer Locks(读写锁)等同步手段.

不过最简单、最轻便(速度最快)的同步手段还是 CriticalSection(临界区), 但它不属于系统内核对象, 当然也就没有句柄、没有 TSecurityAttributes 这个安全属性, 这也导致它不能跨进程使用; 不过写多线程时一般不用跨进程, 所以 CriticalSection 应该是最常用的同步手段.

二、临界区。
先看一段程序, 代码文件:
  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.  
        ListBox1: TListBox; 
  12.  
        Button1: TButton; 
  13.  
         procedure  FormCreate(Sender: TObject); 
  14.  
         procedure  Button1Click(Sender: TObject); 
  15.  
       end
  16.  
     
  17.  
    var 
  18.  
      Form1: TForm1; 
  19.  
     
  20.  
    implementation 
  21.  
     
  22.  
    {$R *.dfm} 
  23.  
     
  24.  
    function  MyThreadFun(p: Pointer): DWORD;  stdcall
  25.  
    var 
  26.  
      i: Integer; 
  27.  
    begin 
  28.  
       for i :=  0  to  99  do Form1.ListBox1.Items.Add(IntToStr(i)); 
  29.  
      Result :=  0
  30.  
    end
  31.  
     
  32.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  33.  
    var 
  34.  
      ID: DWORD; 
  35.  
    begin 
  36.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  37.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  38.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  39.  
    end
  40.  
     
  41.  
    procedure  TForm1.FormCreate(Sender: TObject); 
  42.  
    begin 
  43.  
      ListBox1.Align := alLeft; 
  44.  
    end
  45.  
     
  46.  
    end.
在这段程序中, 有三个线程几乎是同时建立, 向窗体中的 ListBox1 中写数据, 最后写出的结果是这样的:

能不能让它们别打架, 一个完了另一个再来? 这就要用到多线程的同步技术.
前面说过, 最简单的同步手段就是 "临界区".

先说这个 "同步"(Synchronize), 首先这个名字起的不好, 我们好像需要的是 "异步"; 其实异步也不准确...
管它叫什么名字呢, 它的目的就是保证不冲突、有次序、都发生.

"临界区"(CriticalSection): 当把一段代码放入一个临界区, 线程执行到临界区时就独占了, 让其他也要执行此代码的线程先等等; 这和前面用的 Lock 和 UnLock 差不多; 使用格式如下:
  1.  
    var CS: TRTLCriticalSection;    {声明一个 TRTLCriticalSection 结构类型变量; 它应该是全局的} 
  2.  
    InitializeCriticalSection(CS);  {初始化} 
  3.  
    EnterCriticalSection(CS);       {开始: 轮到我了其他线程走开} 
  4.  
    LeaveCriticalSection(CS);       {结束: 其他线程可以来了} 
  5.  
    DeleteCriticalSection(CS);      {删除: 注意不能过早删除} 
  6.  
     
  7.  
    //也可用 TryEnterCriticalSection 替代 EnterCriticalSection.
用上临界区, 重写上面的代码, 运行效果图:

  1.  
    //用临界区重写后的代码文件:  
  2.  
    unit Unit1; 
  3.  
     
  4.  
    interface 
  5.  
     
  6.  
    uses 
  7.  
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  8.  
      Dialogs, StdCtrls; 
  9.  
     
  10.  
    type 
  11.  
       TForm1 =  class(TForm) 
  12.  
        ListBox1: TListBox; 
  13.  
        Button1: TButton; 
  14.  
         procedure  FormCreate(Sender: TObject); 
  15.  
         procedure  FormDestroy(Sender: TObject); 
  16.  
         procedure  Button1Click(Sender: TObject); 
  17.  
       end
  18.  
     
  19.  
    var 
  20.  
      Form1: TForm1; 
  21.  
     
  22.  
    implementation 
  23.  
     
  24.  
    {$R *.dfm} 
  25.  
     
  26.  
    var 
  27.  
      CS: TRTLCriticalSection; 
  28.  
     
  29.  
    function  MyThreadFun(p: Pointer): DWORD;  stdcall
  30.  
    var 
  31.  
      i: Integer; 
  32.  
    begin 
  33.  
      EnterCriticalSection(CS); 
  34.  
       for i :=  0  to  99  do Form1.ListBox1.Items.Add(IntToStr(i)); 
  35.  
      LeaveCriticalSection(CS); 
  36.  
      Result :=  0
  37.  
    end
  38.  
     
  39.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  40.  
    var 
  41.  
      ID: DWORD; 
  42.  
    begin 
  43.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  44.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  45.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  46.  
    end
  47.  
     
  48.  
    procedure  TForm1.FormCreate(Sender: TObject); 
  49.  
    begin 
  50.  
      ListBox1.Align := alLeft; 
  51.  
      InitializeCriticalSection(CS); 
  52.  
    end
  53.  
     
  54.  
    procedure  TForm1.FormDestroy(Sender: TObject); 
  55.  
    begin 
  56.  
      DeleteCriticalSection(CS); 
  57.  
    end
  58.  
     
  59.  
    end.
Delphi 在 SyncObjs 单元给封装了一个 TCriticalSection 类, 用法差不多, 代码如下:
  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.  
        ListBox1: TListBox; 
  12.  
        Button1: TButton; 
  13.  
         procedure  FormCreate(Sender: TObject); 
  14.  
         procedure  FormDestroy(Sender: TObject); 
  15.  
         procedure  Button1Click(Sender: TObject); 
  16.  
       end
  17.  
     
  18.  
    var 
  19.  
      Form1: TForm1; 
  20.  
     
  21.  
    implementation 
  22.  
     
  23.  
    {$R *.dfm} 
  24.  
     
  25.  
    uses SyncObjs; 
  26.  
     
  27.  
    var 
  28.  
      CS: TCriticalSection; 
  29.  
     
  30.  
    function  MyThreadFun(p: Pointer): DWORD;  stdcall
  31.  
    var 
  32.  
      i: Integer; 
  33.  
    begin 
  34.  
      CS.Enter; 
  35.  
       for i :=  0  to  99  do Form1.ListBox1.Items.Add(IntToStr(i)); 
  36.  
      CS.Leave; 
  37.  
      Result :=  0
  38.  
    end
  39.  
     
  40.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  41.  
    var 
  42.  
      ID: DWORD; 
  43.  
    begin 
  44.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  45.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  46.  
      CreateThread( nil0, @MyThreadFun,  nil0, ID); 
  47.  
    end
  48.  
     
  49.  
    procedure  TForm1.FormCreate(Sender: TObject); 
  50.  
    begin 
  51.  
      ListBox1.Align := alLeft; 
  52.  
      CS := TCriticalSection.Create; 
  53.  
    end
  54.  
     
  55.  
    procedure  TForm1.FormDestroy(Sender: TObject); 
  56.  
    begin 
  57.  
      CS.Free; 
  58.  
    end
  59.  
     
  60.  
    end.
三、等待函数 WaitForSingleObject
一下子跳到等待函数 WaitForSingleObject, 是因为下面的 Mutex、Semaphore、Event、WaitableTimer 等同步手段都要使用这个函数; 不过等待函数可不止 WaitForSingleObject 它一个, 但它最简单.
  1.  
    function  WaitForSingleObject
  2.  
      hHandle: THandle;       {要等待的对象句柄}  
  3.  
      dwMilliseconds: DWORD   {等待的时间, 单位是毫秒}  
  4.  
    ): DWORD;  stdcall;        {返回值如下:} 
  5.  
     
  6.  
    WAIT_OBJECT_0   {等着了, 本例中是: 等的那个进程终于结束了} 
  7.  
    WAIT_TIMEOUT    {等过了点(你指定的时间), 也没等着} 
  8.  
    WAIT_ABANDONED  {好不容易等着了, 但人家还是不让咱执行; 这一般是互斥对象} 
  9.  
     
  10.  
    //WaitForSingleObject 的第二个参数一般给常数值 INFINITE, 表示一直等下去, 死等.  

WaitForSingleObject 等待什么? 在多线程里就是等待另一个线程的结束, 快来执行自己的代码; 不过它可以等待的对象可不止线程; 这里先来一个等待另一个进程结束的例子, 运行效果图:

  1.  
    //WaitForSingleObject的示例代码文件:  
  2.  
     
  3.  
    unit Unit1; 
  4.  
     
  5.  
    interface 
  6.  
     
  7.  
    uses 
  8.  
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  9.  
      Dialogs, StdCtrls; 
  10.  
     
  11.  
    type 
  12.  
       TForm1 =  class(TForm) 
  13.  
        Button1: TButton; 
  14.  
         procedure  Button1Click(Sender: TObject); 
  15.  
       end
  16.  
     
  17.  
    var 
  18.  
      Form1: TForm1; 
  19.  
     
  20.  
    implementation 
  21.  
     
  22.  
    {$R *.dfm} 
  23.  
     
  24.  
    var 
  25.  
      hProcess: THandle;  {进程句柄} 
  26.  
     
  27.  
    {等待一个指定句柄的进程什么时候结束} 
  28.  
    function  MyThreadFun(p: Pointer): DWORD;  stdcall
  29.  
    begin 
  30.  
       if WaitForSingleObject(hProcess, INFINITE) = WAIT_OBJECT_0  then 
  31.  
        Form1.Text := Format( '进程 %d 已关闭', [hProcess]); 
  32.  
      Result :=  0
  33.  
    end
  34.  
     
  35.  
    {启动一个进程, 并建立新线程等待它的结束} 
  36.  
    procedure  TForm1.Button1Click(Sender: TObject); 
  37.  
    var 
  38.  
      pInfo: TProcessInformation; 
  39.  
      sInfo: TStartupInfo; 
  40.  
      Path:  array[ 0..MAX_PATH -1of Char; 
  41.  
      ThreadID: DWORD; 
  42.  
    begin 
  43.  
       {先获取记事本的路径} 
  44.  
      GetSystemDirectory(Path, MAX_PATH); 
  45.  
      StrCat(Path,  '\notepad.exe'); 
  46.  
     
  47.  
       {用 CreateProcess 打开记事本并获取其进程句柄, 然后建立线程监视} 
  48.  
      FillChar(sInfo, SizeOf(sInfo),  0); 
  49.  
       if CreateProcess(Path,  nilnilnil, False,  0nilnil, sInfo, pInfo)  then 
  50.  
       begin 
  51.  
        hProcess := pInfo.hProcess;                            {获取进程句柄} 
  52.  
        Text := Format( '进程 %d 已启动', [hProcess]);  
  53.  
        CreateThread( nil0, @MyThreadFun,  nil0, ThreadID);  {建立线程监视} 
  54.  
       end
  55.  
    end
  56.  
     
  57.  
    end.

猜你喜欢

转载自www.cnblogs.com/approx/p/11805279.html