Boss Thread and worker threads communication

unit frmMain;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TformMain = class(TForm)
    memInfo: TMemo;
    lbxThreads: TListBox;
    pnlOptions: TPanel;
    btnPauseResume: TButton;
    btnStart: TButton;
    btnStop: TButton;
    btnAddWorker: TButton;
    procedure btnAddWorkerClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
  private
    fNumber: Integer;
    procedure ReturningInfo(Sender: TObject; Msg: TStrings);
  public
    constructor Create(AOwner: TComponent); override;
  end;
 
var
  formMain: TformMain;
 
implementation
 
uses threadBoss;
 
{$R *.dfm}
 
type
  TCountingThread = class(TWorkerThread)
  protected
    procedure DoAction; override;
  end;
 
procedure TformMain.btnAddWorkerClick(Sender: TObject);
var x: TTask;
begin
  x := TTask.Create;
  x.WorkerThreadClass := TCountingThread;
  x.Name := 'Worker' + IntToStr(fNumber);
  lbxThreads.Items.Values[x.Name] := ';
  AddTask(x);
  Inc(fNumber);
end;
 
{ TCountingThread }
 
procedure TCountingThread.DoAction;
var I, n: Integer;
 
begin
  I := 0;
  n := Random(10) + 3;
  repeat
    Sleep(1000);
    SignalStatus(IntToStr(I));
    Inc(I);
  until I >= n;
end;
 
procedure TformMain.ReturningInfo(Sender: TObject; Msg: TStrings);
var I: Integer;
begin
  memInfo.Lines := Msg;
  with lbxThreads.Items do
    for I := 0 to Count - 1 do
      Values[Names[I]] := Msg.Values[Names[I]+'_STATUS'];
end;
 
procedure TformMain.btnStartClick(Sender: TObject);
begin
  StartBoss(ReturningInfo);
  btnAddWorker.Enabled := True;
end;
 
constructor TformMain.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fNumber := 1;
end;
 
end.

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:

unit threadBoss;
 
interface
 
uses Classes, SysUtils, SyncObjs;
 
{$WRITEABLECONST ON}
 
const
  AutoStartBossThread: Boolean = True;
 
type
  TWorkerThread = class;
  TTask = class;
 
  TTaskStatus = (tsNotStarted, tsInit, tsRunning, tsFinished, tsError);
 
  TSignalToBossEvent = procedure (Sender: TObject; TaskName: string; WorkerMsg: TStrings) of object;
 
  TTaskItem = class(TCollectionItem)
  private
    fTask: TTask;
    fStatus: TTaskStatus;
    fThread: TWorkerThread;
    fSignalToBoss: TSignalToBossEvent;
  protected
    procedure ThreadSignal(Sender: TObject; Msg: TStrings);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  end;
 
  TTaskItems = class(TCollection)
  private
    function GetItems(Index: Integer): TTaskItem;
  protected
  public
    constructor Create;
    function Add: TTaskItem;
    property Items[Index: Integer]: TTaskItem read GetItems;
  end;
 
 
  TSignalBossEvent = procedure (Sender: TObject; Msg: TStrings) of object;
  TBossThread = class(TThread)
  private
    fMaxWorkers: Integer;
    fWorkers: TThreadList;
    fEvent: TEvent;
    fSignalMsgEvent: TSignalBossEvent;
    fMsg: TStrings;
    procedure CheckNewTasks;
    procedure StartTask(aTaskItem: TTaskItem);
  protected
    procedure DoSignal; virtual;
    procedure Signal; virtual;
    procedure OnThreadMsg(Sender: TObject; TaskName: string; WorkerMsg: TStrings);
    procedure Execute; override;
    procedure ThreadTerminated(Sender: TObject);
  public
    constructor Create(CreateSuspended: Boolean; aSignalMsgEvent: TSignalBossEvent = nil; aMaxWorkers: integer = 5);
    destructor Destroy; override;
    class procedure Warning;
  end;
 
  TSignalWorkerEvent = procedure (Sender: TObject; Msg: TStrings) of object;
  TWorkerThread = class(TThread)
  private
    fMsgInfo: TStrings;
    fSignalMsgEvent: TSignalWorkerEvent;
    fUseSynchronize: Boolean;
  protected
    procedure CreateMsgInfo; virtual;
    procedure Execute; override;
    procedure DoSignal; virtual;
    procedure Signal; virtual;
    procedure SignalBegin; virtual;
    procedure SignalEnd; virtual;
    procedure SignalError(aMsg: string); virtual;
    procedure SignalStatus(aMsg: string); virtual;
  public
    constructor Create(CreateSuspended: Boolean; aSignalMsgEvent: TSignalWorkerEvent = nil; aUseSynchronize: boolean = True); reintroduce;
    destructor Destroy; override;
    procedure DoAction; virtual;
  end;
 
  TWorkerThreadClass = class of TWorkerThread;
 
  TTask = class(TObject)
  private
    fWorkerThreadClass: TWorkerThreadClass;
    fName: string;
  protected
  public
    property Name: string read fName write fName;
    property WorkerThreadClass: TWorkerThreadClass read fWorkerThreadClass write fWorkerThreadClass;
  end;
 
procedure AddTask(aTask: TTask);
procedure StartBoss(ReturnInfoEvent: TSignalBossEvent = nil);
 
implementation
 
var
  mTasks: TTaskItems;
  mTaskCs: TCriticalSection;
  mBoss: TBossThread;
 
procedure StartBoss(ReturnInfoEvent: TSignalBossEvent = nil);
begin
  if not Assigned(mBoss) then
    mBoss := TBossThread.Create(False, ReturnInfoEvent);
end;
 
procedure InitTasks;
begin
  mTasks := TTaskItems.Create;
  mTaskCs := TCriticalSection.Create;
end;
 
procedure DoneTasks;
begin
  FreeAndNil(mTaskCs);
  FreeAndNil(mTasks);
end;
 
procedure AddTask(aTask: TTask);
begin
  if Assigned(aTask) then
  begin
    mTaskCs.Enter;
    try
      with mTasks.Add do
        fTask := aTask;
      TBossThread.Warning;
    finally
      mTaskCs.Leave;
    end;
  end;
end;
 
{ TTaskItem }
 
constructor TTaskItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  fTask := Nil;
  fStatus := tsNotStarted;
end;
 
destructor TTaskItem.Destroy;
begin
  FreeAndNil(fTask);
  inherited Destroy;
end;
 
procedure TTaskItem.ThreadSignal(Sender: TObject; Msg: TStrings);
var msgStatus: string;
begin
  msgStatus := Msg.Values['STATUS'];
  if msgStatus = 'BEGIN' then
    fStatus := tsInit
  else if msgStatus = 'STATUS' then
    fStatus := tsRunning
  else if msgStatus = 'END' then
    fStatus := tsFinished
  else if msgStatus = 'ERROR' then
    fStatus := tsError;
  if Assigned(fSignalToBoss) then
    fSignalToBoss(Sender, fTask.Name, Msg);
end;
 
{ TTaskItems }
 
function TTaskItems.Add: TTaskItem;
begin
  Result := TTaskItem(inherited Add);
end;
 
constructor TTaskItems.Create;
begin
  inherited Create(TTaskItem);
end;
 
function TTaskItems.GetItems(Index: Integer): TTaskItem;
begin
  Result := TTaskItem(inherited Items[Index]);
end;
 
{ TBossThread }
 
constructor TBossThread.Create(CreateSuspended: Boolean; aSignalMsgEvent: TSignalBossEvent = nil; aMaxWorkers: integer = 5);
begin
  inherited Create(CreateSuspended);
  fMaxWorkers := aMaxWorkers;
  fWorkers := TThreadList.Create;
  fEvent := TEvent.Create(nil, False, False, 'thread_boss');
  fSignalMsgEvent := aSignalMsgEvent;
  fMsg := TStringList.Create;
end;
 
destructor TBossThread.Destroy;
begin
  FreeAndNil(fMsg);
  FreeAndNil(fEvent);
  FreeAndNil(fWorkers);
  inherited Destroy;
end;
 
procedure TBossThread.DoSignal;
begin
  Synchronize(Signal);
end;
 
procedure TBossThread.Signal;
begin
  if Assigned(fSignalMsgEvent) then
    fSignalMsgEvent(Self, fMsg);
end;
 
procedure TBossThread.StartTask(aTaskItem: TTaskItem);
begin
  with fWorkers.LockList do
  try
    if Count < fMaxWorkers then
    begin
      with aTaskItem do
      begin
        fSignalToBoss := OnThreadMsg;
        fStatus := tsInit;
        fThread := fTask.fWorkerThreadClass.Create(True, aTaskItem.ThreadSignal);
        fThread.FreeOnTerminate := True;
        fThread.OnTerminate := ThreadTerminated;
        Add(fThread);
        fThread.Resume;
      end;
    end;
  finally
    fWorkers.UnlockList;
  end;
end;
 
procedure TBossThread.ThreadTerminated(Sender: TObject);
begin
  with fWorkers.LockList do
  try
    Delete(IndexOf(Sender));
  finally
    fWorkers.UnlockList;
  end;
end;
 
procedure TBossThread.CheckNewTasks;
var I: Integer;
begin
  mTaskCs.Enter;
  try
    for I := 0 to mTasks.Count - 1 do
      if mTasks.Items[I].fStatus in [tsNotStarted] then
      begin
        StartTask(mTasks.Items[I]);
        Break;
      end;
  finally
    mTaskCs.Leave;
  end;
end;
 
procedure TBossThread.Execute;
begin
  while not Terminated do
  begin
    case fEvent.WaitFor(200) of
      wrSignaled    : ;
      wrTimeout     : CheckNewTasks;
      wrAbandoned   : ;
      wrError       : ;
      wrIOCompletion: ;
    end;
  end;
end;
 
procedure TBossThread.OnThreadMsg(Sender: TObject; TaskName: string; WorkerMsg: TStrings);
var I: Integer;
begin
  for I := 0 to WorkerMsg.Count - 1 do
    fMsg.Values[TaskName + '_' + WorkerMsg.Names[I]] := WorkerMsg.ValueFromIndex[I];
  DoSignal;
end;
 
class procedure TBossThread.Warning;
begin
  if not Assigned(mBoss) and AutoStartBossThread then
    StartBoss;
  if Assigned(mBoss) then
    mBoss.fEvent.SetEvent;
end;
 
{ TWorkerThread }
 
constructor TWorkerThread.Create(CreateSuspended: Boolean; aSignalMsgEvent: TSignalWorkerEvent = nil; aUseSynchronize: boolean = True);
begin
  inherited Create(CreateSuspended);
  CreateMsgInfo;
  fSignalMsgEvent := aSignalMsgEvent;
  fUseSynchronize := aUseSynchronize;
end;
 
procedure TWorkerThread.CreateMsgInfo;
begin
  fMsgInfo := TStringList.Create;
end;
 
destructor TWorkerThread.Destroy;
begin
  FreeAndNil(fMsgInfo);
  inherited Destroy;
end;
 
procedure TWorkerThread.DoAction;
begin
  // override this method in descendant
end;
 
procedure TWorkerThread.Execute;
begin
  SignalBegin;
  try
    try
      DoAction;
    except
      on E: Exception do
        SignalError(E.Message);
    end;
  finally
    SignalEnd;
  end;
end;
 
procedure TWorkerThread.Signal;
begin
  if Assigned(fSignalMsgEvent) then
    fSignalMsgEvent(Self, fMsgInfo);
end;
 
procedure TWorkerThread.DoSignal;
begin
  if fUseSynchronize then
    Synchronize(Signal)
  else
    Signal;
end;
 
procedure TWorkerThread.SignalBegin;
begin
  fMsgInfo.Values['STATUS'] := 'BEGIN';
  DoSignal;
end;
 
procedure TWorkerThread.SignalEnd;
begin
  fMsgInfo.Values['STATUS'] := 'END';
  DoSignal;
end;
 
procedure TWorkerThread.SignalError(aMsg: string);
begin
  fMsgInfo.Values['STATUS'] := 'ERROR';
  fMsgInfo.Values['ERRORMSG'] := aMsg;
  DoSignal;
end;
 
procedure TWorkerThread.SignalStatus(aMsg: string);
begin
  fMsgInfo.Values['STATUS'] := 'STATUS';
  fMsgInfo.Values['STATUSMSG'] := aMsg;
  DoSignal;
end;
 
initialization
  InitTasks;
finalization
  DoneTasks;
end.

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384: