多线程编程(13) 多线程同步之 Event (事件对象)

据说 Event(事件对象) 是多线程最原始的同步手段, 我觉得它是最灵活的一个.
Event 对象(的句柄表)中主要有两个布尔变量, 从它的建立函数中可以看得清楚:

function CreateEvent(
  lpEventAttributes: PSecurityAttributes; {安全设置}
  bManualReset: BOOL;                     {第一个布尔}
  bInitialState: BOOL;                    {第二个布尔}
  lpName: PWideChar                       {对象名称}
): THandle; stdcall;                      {返回对象句柄}

//第一个布尔为 False 时, 事件对象控制一次后将立即重置(暂停); 为 True 时可手动暂停.
//第二个布尔为 False 时, 对象建立后控制为暂停状态; True 是可运行状态.

和其他同类相比, 它的灵活性在于可随时 "启动运行"(SetEvent) 和 "暂停运行"(ResetEvent);
甚至还有个 PulseEvent 函数, 能控制执行一次后立即暂停, 很是方便.

---

本例效果图:

---

代码文件:

---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  f: Integer;      {用这个变量协调一下各线程输出的位置}
  hEvent: THandle; {事件对象的句柄}

function MyThreadFun(p: Pointer): DWORD; stdcall;
var
  i,y: Integer;
begin
  Inc(f);
  y := 20 * f;
  for i := 0 to 200000 do
  begin
    if WaitForSingleObject(hEvent, INFINITE) = WAIT_OBJECT_0 then
    begin
      Form1.Canvas.Lock;
      Form1.Canvas.TextOut(20, y, IntToStr(i));
      Form1.Canvas.Unlock;
    end;
  end;
  Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Repaint; f := 0;
  CloseHandle(hEvent); {如果已经创建过}
  hEvent := CreateEvent(nil, True, True, nil);
end;

{创建线程}
procedure TForm1.Button2Click(Sender: TObject);
var
  ThreadID: DWORD;
begin
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
end;

{暂停}
procedure TForm1.Button3Click(Sender: TObject);
begin
  ResetEvent(hEvent);
end;

{启动}
procedure TForm1.Button4Click(Sender: TObject);
begin
  SetEvent(hEvent);
end;

{启动后执行一次立即暂停}
procedure TForm1.Button5Click(Sender: TObject);
begin
  PulseEvent(hEvent);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.Caption := '创建 Event 对象';
  Button2.Caption := '创建线程';
  Button3.Caption := 'ResetEvent';
  Button4.Caption := 'SetEvent';
  Button5.Caption := 'PulseEvent';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CloseHandle(hEvent);
end;

end.

窗体文件:

---

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 149
  ClientWidth = 228
  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 Button1: TButton
    Left = 8
    Top = 116
    Width = 129
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button3: TButton
    Left = 143
    Top = 12
    Width = 75
    Height = 25
    Caption = 'Button3'
    TabOrder = 1
    OnClick = Button3Click
  end
  object Button4: TButton
    Left = 143
    Top = 43
    Width = 75
    Height = 25
    Caption = 'Button4'
    TabOrder = 2
    OnClick = Button4Click
  end
  object Button5: TButton
    Left = 143
    Top = 74
    Width = 75
    Height = 25
    Caption = 'Button5'
    TabOrder = 3
    OnClick = Button5Click
  end
  object Button2: TButton
    Left = 143
    Top = 116
    Width = 75
    Height = 25
    Caption = 'Button2'
    TabOrder = 4
    OnClick = Button2Click
  end
end

和前面一样, 再用 SyncObjs 单元下的 TEvent 类实现一次; 不过它没有实现类似 PulseEvent 的功能:

---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses SyncObjs;
var
  f: Integer;
  MyEvent: TEvent;

function MyThreadFun(p: Pointer): DWORD; stdcall;
var
  i,y: Integer;
begin
  Inc(f);
  y := 20 * f;
  for i := 0 to 200000 do
  begin
    if MyEvent.WaitFor(INFINITE) = wrSignaled then
    begin
      Form1.Canvas.Lock;
      Form1.Canvas.TextOut(20, y, IntToStr(i));
      Form1.Canvas.Unlock;
    end;
  end;
  Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Repaint; f := 0;
  if Assigned(MyEvent) then MyEvent.Free;
  MyEvent := TEvent.Create(nil, True, True, '');
end;

{创建线程}
procedure TForm1.Button2Click(Sender: TObject);
var
  ThreadID: DWORD;
begin
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
end;

{暂停}
procedure TForm1.Button3Click(Sender: TObject);
begin
  MyEvent.ResetEvent;
end;

{启动}
procedure TForm1.Button4Click(Sender: TObject);
begin
  MyEvent.SetEvent;
end;

{启动后执行一次立即暂停}
procedure TForm1.Button5Click(Sender: TObject);
begin
  ShowMessage('TEvent 类没有提供这个功能'); {我试过用 PulseEvent(MyEvent.Handle) 也不行}
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.Caption := '创建 Event 对象';
  Button2.Caption := '创建线程';
  Button3.Caption := 'ResetEvent';
  Button4.Caption := 'SetEvent';
  Button5.Caption := 'PulseEvent';
end;

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

end.