多线程编程(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.posted on 2009-02-16 00:28 万一 阅读(12996) 评论(15) 编辑 收藏