{ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * * * *************************************************************************** Abstract: Demo to show, how a Thread waits for another. Important: In most (all?) Unix like systems, the cthread unit must be added to the uses section of the .lpr file. Further, cmem is likely to be significently faster so add it as well. Due to how the units work a sensible order is cmem, cthreads and then perhaps cwstrings. But note that heaptrc does not work with cmem so comment it out while testing/debugging. } unit WaitForUnit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls, LCLProc; type { TBaseThread } TBaseThread = class(TThread) public procedure Log(const Msg: string; AppendLineEnd: boolean = true); end; { TThreadA } TThreadA = class(TBaseThread) public WaitForB: PRtlEvent; procedure Execute; override; end; { TThreadB } TThreadB = class(TBaseThread) private FCounter: integer; public procedure Execute; override; property Counter: integer read FCounter write FCounter; end; { TForm1 } TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private ACriticalSection: TRTLCriticalSection; MsgText: string; procedure AddMessage; public ThreadA: TThreadA; ThreadB: TThreadB; end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.Button1Click(Sender: TObject); begin if ThreadA=nil then ThreadA:=TThreadA.Create(false); end; procedure TForm1.FormCreate(Sender: TObject); begin InitCriticalSection(ACriticalSection); end; procedure TForm1.FormDestroy(Sender: TObject); begin DoneCriticalsection(ACriticalSection); end; procedure TForm1.AddMessage; begin Memo1.Lines.Text:=MsgText; end; { TThreadA } procedure TThreadA.Execute; begin Form1.ThreadB:=TThreadB.Create(false); // create event WaitForB:=RTLEventCreate; while not Application.Terminated do begin Log('A: wait for B ...'); // wait infinitely (until B wakes A) RtlEventWaitFor(WaitForB); Log('A: ThreadB.Counter='+IntToStr(Form1.ThreadB.Counter)); end; end; { TThreadB } procedure TThreadB.Execute; var i: Integer; begin Counter:=0; while not Application.Terminated do begin Log('B: Working ...'); for i:=1 to 5 do begin Sleep(300); Log('..... ',false); end; Log(''); Counter := Counter + 1; Log('B: Wake A'); // wake A RtlEventSetEvent(Form1.ThreadA.WaitForB); end; end; { TBaseThread } procedure TBaseThread.Log(const Msg: string; AppendLineEnd: boolean); var s: String; begin EnterCriticalsection(Form1.ACriticalSection); s:=Msg; if AppendLineEnd then s:=s+LineEnding; dbgout(s); Form1.MsgText:=Form1.MsgText+s; Synchronize(@Form1.AddMessage); LeaveCriticalsection(Form1.ACriticalSection); end; end.