据说 Event(事件对象) 是多线程最原始的同步手段, 我觉得它是最灵活的一个.
Event 对象(的句柄表)中主要有两个布尔变量, 从它的建立函数中可以看得清楚:
function CreateEvent(lpEventAttributes: PSecurityAttributes; {安全设置}bManualReset: BOOL; {第一个布尔}bInitialState: BOOL; {第二个布尔}lpName: PWideChar {对象名称}
): THandle; stdcall; {返回对象句柄}//第一个布尔为 False 时, 事件对象控制一次后将立即重置(暂停); 为 True 时可手动暂停.
//第二个布尔为 False 时, 对象建立后控制为暂停状态; True 是可运行状态.
和其他同类相比, 它的灵活性在于可随时 "启动运行"(SetEvent) 和 "暂停运行"(ResetEvent);
甚至还有个 PulseEvent 函数, 能控制执行一次后立即暂停, 很是方便.
本例效果图:
代码文件:
unit Unit1;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls;typeTForm1 = 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;varForm1: TForm1;implementation{$R *.dfm}varf: Integer; {用这个变量协调一下各线程输出的位置}hEvent: THandle; {事件对象的句柄}function MyThreadFun(p: Pointer): DWORD; stdcall;
vari,y: Integer;
beginInc(f);y := 20 * f;for i := 0 to 200000 dobeginif WaitForSingleObject(hEvent, INFINITE) = WAIT_OBJECT_0 thenbeginForm1.Canvas.Lock;Form1.Canvas.TextOut(20, y, IntToStr(i));Form1.Canvas.Unlock;end;end;Result := 0;
end;procedure TForm1.Button1Click(Sender: TObject);
beginRepaint; f := 0;CloseHandle(hEvent); {如果已经创建过}hEvent := CreateEvent(nil, True, True, nil);
end;{创建线程}
procedure TForm1.Button2Click(Sender: TObject);
varThreadID: DWORD;
beginCreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
end;{暂停}
procedure TForm1.Button3Click(Sender: TObject);
beginResetEvent(hEvent);
end;{启动}
procedure TForm1.Button4Click(Sender: TObject);
beginSetEvent(hEvent);
end;{启动后执行一次立即暂停}
procedure TForm1.Button5Click(Sender: TObject);
beginPulseEvent(hEvent);
end;procedure TForm1.FormCreate(Sender: TObject);
beginButton1.Caption := '创建 Event 对象';Button2.Caption := '创建线程';Button3.Caption := 'ResetEvent';Button4.Caption := 'SetEvent';Button5.Caption := 'PulseEvent';
end;procedure TForm1.FormDestroy(Sender: TObject);
beginCloseHandle(hEvent);
end;end.
窗体文件:
object Form1: TForm1Left = 0Top = 0Caption = 'Form1'ClientHeight = 149ClientWidth = 228Color = clBtnFaceFont.Charset = DEFAULT_CHARSETFont.Color = clWindowTextFont.Height = -11Font.Name = 'Tahoma'Font.Style = []OldCreateOrder = FalseOnCreate = FormCreatePixelsPerInch = 96TextHeight = 13object Button1: TButtonLeft = 8Top = 116Width = 129Height = 25Caption = 'Button1'TabOrder = 0OnClick = Button1Clickendobject Button3: TButtonLeft = 143Top = 12Width = 75Height = 25Caption = 'Button3'TabOrder = 1OnClick = Button3Clickendobject Button4: TButtonLeft = 143Top = 43Width = 75Height = 25Caption = 'Button4'TabOrder = 2OnClick = Button4Clickendobject Button5: TButtonLeft = 143Top = 74Width = 75Height = 25Caption = 'Button5'TabOrder = 3OnClick = Button5Clickendobject Button2: TButtonLeft = 143Top = 116Width = 75Height = 25Caption = 'Button2'TabOrder = 4OnClick = Button2Clickend end
和前面一样, 再用 SyncObjs 单元下的 TEvent 类实现一次; 不过它没有实现类似 PulseEvent 的功能:
unit Unit1;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls;typeTForm1 = 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;varForm1: TForm1;implementation{$R *.dfm}uses SyncObjs;
varf: Integer;MyEvent: TEvent;function MyThreadFun(p: Pointer): DWORD; stdcall;
vari,y: Integer;
beginInc(f);y := 20 * f;for i := 0 to 200000 dobeginif MyEvent.WaitFor(INFINITE) = wrSignaled thenbeginForm1.Canvas.Lock;Form1.Canvas.TextOut(20, y, IntToStr(i));Form1.Canvas.Unlock;end;end;Result := 0;
end;procedure TForm1.Button1Click(Sender: TObject);
beginRepaint; f := 0;if Assigned(MyEvent) then MyEvent.Free;MyEvent := TEvent.Create(nil, True, True, '');
end;{创建线程}
procedure TForm1.Button2Click(Sender: TObject);
varThreadID: DWORD;
beginCreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
end;{暂停}
procedure TForm1.Button3Click(Sender: TObject);
beginMyEvent.ResetEvent;
end;{启动}
procedure TForm1.Button4Click(Sender: TObject);
beginMyEvent.SetEvent;
end;{启动后执行一次立即暂停}
procedure TForm1.Button5Click(Sender: TObject);
beginShowMessage('TEvent 类没有提供这个功能'); {我试过用 PulseEvent(MyEvent.Handle) 也不行}
end;procedure TForm1.FormCreate(Sender: TObject);
beginButton1.Caption := '创建 Event 对象';Button2.Caption := '创建线程';Button3.Caption := 'ResetEvent';Button4.Caption := 'SetEvent';Button5.Caption := 'PulseEvent';
end;procedure TForm1.FormDestroy(Sender: TObject);
beginMyEvent.Free;
end;end.