unit PascalTestForm; interface uses Windows, Messages, SysUtils, SynchedThreads, SyncObjs, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TPascalTest = class(TForm) BeepBtn: TButton; StopStartMsgWaitBtn: TButton; InfiniteWaitBtn: TButton; MsgWaitBtn: TButton; StopStartWaitBtn: TButton; EventWaitBtn: TButton; UntilBtn: TButton; SpawnBtn: TButton; WaitBtn: TButton; procedure BeepBtnClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure StopStartMsgWaitBtnClick(Sender: TObject); procedure InfiniteWaitBtnClick(Sender: TObject); procedure MsgWaitBtnClick(Sender: TObject); procedure StopStartWaitBtnClick(Sender: TObject); procedure EventWaitBtnClick(Sender: TObject); procedure UntilBtnClick(Sender: TObject); procedure SpawnBtnClick(Sender: TObject); procedure WaitBtnClick(Sender: TObject); private { Private declarations } Thread: TStopStartThread; WaitThread: TWaitThread; UntilFlag: TEvent; procedure Beep(Data: pointer); procedure Pause(Data: pointer); procedure InfinitePause(Data: pointer); procedure wmClose(var Msg: TMessage); message WM_Close; public { Public declarations } end; var PascalTest: TPascalTest; implementation {$R *.DFM} // setup/teardown procedure TPascalTest.FormCreate(Sender: TObject); begin Thread := TStopStartThread.Create; UntilFlag := TEvent.Create(Nil, True, False, ''); WaitThread := Nil; end; // TPascalTest.FormCreate procedure TPascalTest.FormDestroy(Sender: TObject); begin Thread.Free; UntilFlag.Free; end; // TPascalTest.FormDestroy // thread procs procedure TPascalTest.Beep(Data: pointer); begin MessageBeep(0); end; // TPascalTest.Beep procedure TPascalTest.Pause(Data: pointer); begin Sleep(7500); end; // TPascalTest.Pause procedure TPascalTest.InfinitePause(Data: pointer); begin Sleep(INFINITE); end; // TPascalTest.InfinitePause // Event handlers procedure TPascalTest.BeepBtnClick(Sender: TObject); begin RunInThread(Beep, Nil); end; procedure TPascalTest.WaitBtnClick(Sender: TObject); begin WaitBtn.Enabled := False; WaitForThread(Pause, Nil); WaitBtn.Enabled := True; end; procedure TPascalTest.MsgWaitBtnClick(Sender: TObject); begin MsgWaitBtn.Enabled := False; MsgWaitForThread(WaitThread, Pause, Nil); MsgWaitBtn.Enabled := True; end; procedure TPascalTest.StopStartMsgWaitBtnClick(Sender: TObject); begin StopStartMsgWaitBtn.Enabled := False; Thread.MsgWaitFor(Pause, Nil); StopStartMsgWaitBtn.Enabled := True; end; procedure TPascalTest.StopStartWaitBtnClick(Sender: TObject); begin StopStartWaitBtn.Enabled := False; Thread.WaitFor(Pause, Nil); StopStartWaitBtn.Enabled := True; end; procedure TPascalTest.InfiniteWaitBtnClick(Sender: TObject); begin InfiniteWaitBtn.Enabled := False; Thread.MsgWaitFor(InfinitePause, Nil); InfiniteWaitBtn.Enabled := True; end; procedure TPascalTest.EventWaitBtnClick(Sender: TObject); begin EventWaitBtn.Enabled := False; UntilBtn.Enabled := True; UntilFlag.ResetEvent; MsgWaitForSingleObject(UntilFlag.Handle); EventWaitBtn.Enabled := True; UntilBtn.Enabled := False; end; procedure TPascalTest.UntilBtnClick(Sender: TObject); begin UntilFlag.SetEvent; end; procedure TPascalTest.SpawnBtnClick(Sender: TObject); begin SpawnBtn.Enabled := False; MsgWaitForSingleObject(SpawnProcess('test.bat').hProcess); SpawnBtn.Enabled := True; end; procedure TPascalTest.wmClose(var Msg: TMessage); begin if Assigned(WaitThread) then WaitThread.AbortThread; if UntilBtn.Enabled then UntilFlag.SetEvent; if Thread.Waiting then Thread.AbortThread; Close; end; end.