澳洲金沙参的功效:Delphi多线程编程 - 编程技巧文章 - 蓝鸟软件-20

多线程编程(19) - 不使用同步工具, 手动协调线程依次执行

在前面例子的基础上, 探讨新问题.
　　假如我们想让几个线程(例子中是 3 个)依次执行, 我们可以使用临界区、信号、互斥等手段;
　　但下面第一个例子什么同步工具都没用, 也达到了目的; 方法是: 让前一个线程在结束前顺便启动下一个线程.
　　第二个例子使用了互斥对象配合 WaitForSingleObject 函数, 也达到相似的目的.
效果图(两个例子的效果图差不多, 但第二个例子的执行顺序不好保证):

　　第一个例子的代码文件:
unit Unit1;
interface
uses
　Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
　Dialogs, StdCtrls, ExtCtrls;
type
　TForm1 = class(TForm)
　　PaintBox1: TPaintBox;
　　PaintBox2: TPaintBox;
　　PaintBox3: TPaintBox;
　　Button1: TButton;
　　procedure Button1Click(Sender: TObject);
　　procedure FormDestroy(Sender: TObject);
　end;
var
　Form1: TForm1;
implementation
{$R *.dfm}
const
　colors: array[0..2] of TColor = (clRed, clGreen, clBlue);
var
　hArr: array[0..2] of THandle;
　panitArr: array[0..2] of TPaintBox;
function ThreadFun(p: Pointer): Integer; stdcall;
var
　i,n,x1,y1,x2,y2: Integer;
　ThreadID: DWORD;
begin
　n := Integer(p);
　panitArr[n].Color := colors[n];
　for i := 0 to 50 do with panitArr[n] do
　begin
　　x1 := Random(Width); y1 := Random(Height);
　　x2 := Random(Width); y2 := Random(Height);
　　Canvas.Lock;
　　Canvas.Ellipse(x1,y1,x2,y2);
　　Canvas.Unlock;
　　Sleep(2);
　end;
　{在前一个线程收尾时, 如果新建线程不超过 3 个就继续建立}
　Inc(n);
　if n < 3 then hArr[n] := CreateThread(nil, 0, @ThreadFun, Ptr(n), 0, ThreadID);
　Result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
　ID: DWORD;
begin
　panitArr[0] := PaintBox1;
　panitArr[1] := PaintBox2;
　panitArr[2] := PaintBox3;
　{开始只建立了一个线程, 并传入 0 参数作为标识}
　hArr[0] := CreateThread(nil, 0, @ThreadFun, Ptr(0), 0, ID);
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
　i: Integer;
begin
　for i := 0 to Length(hArr) - 1 do CloseHandle(hArr);
end;
end.

　　窗体文件:

object Form1: TForm1
　Left = 0
　Top = 0
　Caption = 'Form1'
　ClientHeight = 156
　ClientWidth = 321
　Color = clBtnFace
　Font.Charset = DEFAULT_CHARSET
　Font.Color = clWindowText
　Font.Height = -11
　Font.Name = 'Tahoma'
　Font.Style = []
　OldCreateOrder = False
　OnDestroy = FormDestroy
　PixelsPerInch = 96
　TextHeight = 13
　object PaintBox1: TPaintBox
　　Left = 8
　　Top = 8
　　Width = 97
　　Height = 113
　end
　object PaintBox2: TPaintBox
　　Left = 111
　　Top = 8
　　Width = 98
　　Height = 113
　end
　object PaintBox3: TPaintBox
　　Left = 215
　　Top = 8
　　Width = 98
　　Height = 113
　end
　object Button1: TButton
　　Left = 238
　　Top = 126
　　Width = 75
　　Height = 25
　　Caption = 'Button1'
　　TabOrder = 0
　　OnClick = Button1Click
　end
end

　　第一个例子的代码文件(窗体同上):

unit Unit1;
interface
uses
　Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
　Dialogs, StdCtrls, ExtCtrls;
type
　TForm1 = class(TForm)
　　PaintBox1: TPaintBox;
　　PaintBox2: TPaintBox;
　　PaintBox3: TPaintBox;
　　Button1: TButton;
　　procedure Button1Click(Sender: TObject);
　　procedure FormDestroy(Sender: TObject);
　end;
var
　Form1: TForm1;
implementation
{$R *.dfm}
const
　colors: array[0..2] of TColor = (clRed, clGreen, clBlue);
var
　hArr: array[0..2] of THandle;
　panitArr: array[0..2] of TPaintBox;
　hMutex: THandle; {互斥对象的句柄}
function ThreadFun(p: Pointer): Integer; stdcall;
var
　i,n,x1,y1,x2,y2: Integer;
begin
　n := Integer(p);
　panitArr[n].Color := colors[n];
　if WaitForSingleObject(hMutex, INFINITE) = WAIT_OBJECT_0 then
　begin
　　for i := 0 to 50 do with panitArr[n] do
　　begin
　　　x1 := Random(Width); y1 := Random(Height);
　　　x2 := Random(Width); y2 := Random(Height);
　　　Canvas.Lock;
　　　Canvas.Ellipse(x1,y1,x2,y2);
　　　Canvas.Unlock;
　　　Sleep(10);
　　end;
　　ReleaseMutex(hMutex);
　end;
　Result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
　ID: DWORD;
　i: Integer;
begin
　panitArr[0] := PaintBox1;
　panitArr[1] := PaintBox2;
　panitArr[2] := PaintBox3;
　CloseHandle(hMutex);
　hMutex := CreateMutex(nil, False, nil);
　for i := 0 to Length(hArr) - 1 do
　　hArr := CreateThread(nil, 0, @ThreadFun, Ptr(i), 0, ID);
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
　i: Integer;
begin
　CloseHandle(hMutex);
　for i := 0 to Length(hArr) - 1 do CloseHandle(hArr);
end;
end.