标签:exit ted classes window controls 必须 messages delphi 阻塞
unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, system.SyncObjs; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Memo1: TMemo; CheckBox1: TCheckBox; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure CheckBox1Click(Sender: TObject); private public { Public declarations } end; TMyThread = class(TThread) protected procedure Execute; override; end; var Form1: TForm1; AEvent: TEvent; MyThread: TMyThread; implementation {$R *.dfm} procedure Log(Msg: string); begin TThread.Synchronize(nil, procedure begin Form1.Memo1.Lines.Add(Msg); end); end; { TMyThread } procedure TMyThread.Execute; begin while not Terminated do begin AEvent.Acquire; Log(DateTimeToStr(Now)); TThread.Sleep(500); end; Log(‘Exit‘); end; procedure TForm1.Button1Click(Sender: TObject); begin AEvent.SetEvent; end; procedure TForm1.Button2Click(Sender: TObject); begin AEvent.ResetEvent; end; procedure TForm1.CheckBox1Click(Sender: TObject); begin MyThread.Terminate; end; procedure TForm1.FormCreate(Sender: TObject); begin Memo1.Clear; AEvent := TEvent.Create(nil, False, False, ‘‘); MyThread := TMyThread.Create(False); end; procedure TForm1.FormDestroy(Sender: TObject); begin if not MyThread.Finished then begin //确保线程正常退出 MyThread.Terminate; AEvent.SetEvent; MyThread.WaitFor; end; MyThread.Free; AEvent.Free; end; end.
AEvent := TEvent.Create(nil, False, False, ‘‘);
第一个False, 线程是否可以执行一次. 如何为True,相当于 do while, 如果为 False , 相当于 while .
第二个False, 相当于线程是否可以直接运行,不需要SetEvent. 如果为 True , 则必须调用 SetEvent 后,线程才能运行。也就是线程启动后就被阻塞住。
当两个同时为 False 时, 就可以实现类似 PulseOneEvent 的功能。
TLightweightEvent 和 TEvent 基本上是一样的,它是从 .NET中的 System.Threading.ManualResetEventSlim 学来的。对于多核,短时间间隔效率更好,可参考 MSDN 。
delphi 多线程之 TEvent 和 TLightweightEvent
标签:exit ted classes window controls 必须 messages delphi 阻塞
原文地址:http://www.cnblogs.com/Jiaojiawang/p/7496836.html