在 Delphi 中使用多线程有两种方法: 调用 API、使用 TThread 类;
使用 API 的代码更简单.
CreateThread
function CreateThread( lpThreadAttributes: Pointer; {安全设置} dwStackSize: DWORD; {堆栈大小} lpStartAddress: TFNThreadStartRoutine; {入口函数} lpParameter: Pointer; {函数参数} dwCreationFlags: DWORD; {启动选项} var lpThreadId: DWORD {输出线程 ID } ): THandle; stdcall; {返回线程句柄}
CreateThread 第三个参数是函数指针, 新线程建立后将立即执行该函数, 函数执行完毕, 系统将销毁此线程从而结束多线程的故事.
CreateThread 要使用的函数是系统级别的, 不能是某个类(譬如: TForm1)的方法, 并且有严格的格式(参数、返回值)要求, 不管你暂时是不是需要都必须按格式来;
因为是系统级调用, 还要缀上 stdcall, stdcall 是协调参数顺序的, 虽然这里只有一个参数没有顺序可言, 但这是使用系统函数的惯例.
CreateThread 还需要一个 var 参数来接受新建线程的 ID, 尽管暂时没用, 但这也是格式;
代码注释:
- 当前程序是一个进程, 进程只是一个工作环境, 线程是工作者;
- 每个进程都会有一个启动线程(或叫主线程), 也就是说: 大量的编码都是写给这个主线程的;
- ExitThread(0); 退出主线程;
- 系统不允许一个没有线程的进程存在, 所以程序就退出了.
- ExitThread 函数的参数是一个退出码, 这个退出码是给之后的其他函数用的, 这里随便给个无符号整数即可.
输出线程 ID
CreateThread 的最后一个参数是 "线程的 ID";
在主线程中 GetCurrentThreadId、MainThreadID、MainInstance 都可以获取主线程的ID.
启动选项
CreateThread 的倒数第二个参数 dwCreationFlags(启动选项) 有两个可选值:
- 0: 线程建立后立即执行入口函数;
- CREATE_SUSPENDED: 线程建立后会挂起等待.
可用 ResumeThread 函数是恢复线程的运行; 可用 SuspendThread 再次挂起线程.
这两个函数的参数都是线程句柄, 返回值是执行前的挂起计数.
挂起记数
SuspendThread 会给这个数 +1; ResumeThread 会给这个数 -1; 但这个数最小是 0.
当这个数 = 0 时, 线程会运行; > 0 时会挂起.
如果被 SuspendThread 多次, 同样需要 ResumeThread 多次才能恢复线程的运行.
多线程示例
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(nil, 0, @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.
多线程同步
"临界区"(CriticalSection): 当把一段代码放入一个临界区, 线程执行到临界区时就独占了, 让其他也要执行此代码的线程先等等;
使用格式如下:
var CS: TRTLCriticalSection; {声明一个 TRTLCriticalSection 结构类型变量; 它应该是全局的} InitializeCriticalSection(CS); {初始化} EnterCriticalSection(CS); {开始: 轮到我了其他线程走开} LeaveCriticalSection(CS); {结束: 其他线程可以来了} DeleteCriticalSection(CS); {删除: 注意不能过早删除}
多线程同步示例
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 var 26 CS: TRTLCriticalSection; 27 28 function MyThreadFun(p: Pointer): DWORD; stdcall; 29 var 30 i: Integer; 31 begin 32 EnterCriticalSection(CS); 33 for i := 0 to 99 do Form1.ListBox1.Items.Add(IntToStr(i)); 34 LeaveCriticalSection(CS); 35 Result := 0; 36 end; 37 38 procedure TForm1.Button1Click(Sender: TObject); 39 var 40 ID: DWORD; 41 begin 42 CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 43 CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 44 CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 45 end; 46 47 procedure TForm1.FormCreate(Sender: TObject); 48 begin 49 ListBox1.Align := alLeft; 50 InitializeCriticalSection(CS); 51 end; 52 53 procedure TForm1.FormDestroy(Sender: TObject); 54 begin 55 DeleteCriticalSection(CS); 56 end; 57 58 end.
参考文章
http://www.cnblogs.com/gzcszzx/articles/2110675.html