先看一段程序, 代码文件:
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;

implementation

{$R *.dfm}

function MyThreadFun(p: Pointer): DWORD; stdcall;
var
  i: Integer;
begin
  for i := 0 to 99 do Form1.ListBox1.Items.Add(IntToStr(i));
  Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ID: DWORD;
begin
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.Align := alLeft;
end;

end.


窗体文件:
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 154
  ClientWidth = 214
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 9
    Top = 9
    Width = 121
    Height = 97
    ItemHeight = 13
    TabOrder = 0
  end
  object Button1: TButton
    Left = 131
    Top = 112
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 1
    OnClick = Button1Click
  end
end


在这段程序中, 有三个线程几乎是同时建立, 向窗体中的 ListBox1 中写数据, 最后写出的结果是这样的:



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

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

"临界区"(CriticalSection): 当把一段代码放入一个临界区, 线程执行到临界区时就独占了, 让其他也要执行此代码的线程先等等; 这和前面用的 Lock 和 UnLock 差不多; 使用格式如下:

var CS: TRTLCriticalSection;   {声明一个 TRTLCriticalSection 结构类型变量; 它应该是全局的}
InitializeCriticalSection(CS); {初始化}
EnterCriticalSection(CS);      {开始: 轮到我了其他线程走开}
LeaveCriticalSection(CS);      {结束: 其他线程可以来了}
DeleteCriticalSection(CS);     {删除: 注意不能过早删除}

//也可用 TryEnterCriticalSection 替代 EnterCriticalSection.


用上临界区, 重写上面的代码, 运行效果图:



代码文件:
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 FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  CS: TRTLCriticalSection;

function MyThreadFun(p: Pointer): DWORD; stdcall;
var
  i: Integer;
begin
  EnterCriticalSection(CS);
  for i := 0 to 99 do Form1.ListBox1.Items.Add(IntToStr(i));
  LeaveCriticalSection(CS);
  Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ID: DWORD;
begin
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.Align := alLeft;
  InitializeCriticalSection(CS);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteCriticalSection(CS);
end;

end.


Delphi 在 SyncObjs 单元给封装了一个 TCriticalSection 类, 用法差不多, 代码如下:
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 FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses SyncObjs;

var
  CS: TCriticalSection;

function MyThreadFun(p: Pointer): DWORD; stdcall;
var
  i: Integer;
begin
  CS.Enter;
  for i := 0 to 99 do Form1.ListBox1.Items.Add(IntToStr(i));
  CS.Leave;
  Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ID: DWORD;
begin
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.Align := alLeft;
  CS := TCriticalSection.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CS.Free;
end;

end.

posted on 2009-02-12 18:15  万一  阅读(18369)  评论(7编辑  收藏  举报