home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue40 / Threads / HVBackgroudThread.pas next >
Encoding:
Pascal/Delphi Source File  |  1998-11-03  |  4.4 KB  |  153 lines
  1. unit HVBackgroudThread;
  2. //
  3. // Written by Hallvard Vassbotn, hallvard@falcon.no
  4. //
  5. // Based on source code Copyright (c) 1998 by Reuters Group PLC
  6. // Reproduction and/or distribution of source code or DCUs strictly prohibited.
  7. //
  8. // For publication in The Delphi Magazine only
  9. //
  10. interface
  11.  
  12. uses
  13.   Classes,
  14.   HVSyncObjs;
  15.  
  16. type
  17.   TBackgroundTask = class;
  18.  
  19.   TTaskDoneEvent = procedure(Task: TBackgroundTask) of object;
  20.  
  21.   TBackgroundTask = class(TObject)
  22.   private
  23.     FTaskDoneEvent : TTaskDoneEvent;
  24.     FCookie        : TObject;
  25.   protected
  26.     procedure Perform; virtual; abstract;
  27.     procedure Done;
  28.   public
  29.     // A magic value to pass back to the event - can be useful sometimes
  30.     property Cookie: TObject read FCookie write FCookie;
  31.     // The event to call when the task is done
  32.     property OnTaskDone: TTaskDoneEvent read FTaskDoneEvent write FTaskDoneEvent;
  33.   end;
  34.   TBackgroundTaskClass = class of TBackgroundTask;
  35.  
  36.   TBackgroundTasksThread = class(TThread)
  37.   private
  38.     FInBox : TWaitableThreadList;
  39.     FOutBox: TWaitableThreadList;
  40.   protected
  41.     // Runs in main context, via Syncronize
  42.     procedure AppHandleException;
  43.     // Runs in thread context
  44.     procedure HandleBackgroundTask(aBackgroundTask: TBackgroundTask);
  45.     procedure Execute; override;
  46.     // Runs in main context
  47.     procedure ItemInOutBoxReady(Sender: TObject);
  48.   public
  49.     // Runs in main context
  50.     constructor Create;
  51.     destructor Destroy; override;
  52.     procedure AddBackgroundTask(aBackgroundTask: TBackgroundTask);
  53.     // Used to communicate between the main and the thread contexts
  54.     property OutBox: TWaitableThreadList read FOutBox;
  55.     property InBox : TWaitableThreadList read FInBox;
  56.   end;
  57.  
  58. implementation
  59.  
  60. uses
  61.   Windows,
  62.   Forms,
  63.   HVUtils,
  64.   HVMultiThreadMain;
  65.  
  66. { --------------------------- TBackgroundTask --------------------------- }
  67.  
  68. procedure TBackgroundTask.Done;
  69. begin
  70.   if Assigned(FTaskDoneEvent) then
  71.     FTaskDoneEvent(Self);
  72. end;
  73.  
  74. { --------------------------- TBackgroundTasksThread --------------------------- }
  75.  
  76. constructor TBackgroundTasksThread.Create;
  77. begin
  78.   // Create the thread in the suspended state
  79.   inherited Create(true);
  80.  
  81.   // Default to low priority!
  82.   Priority           := tpIdle;
  83.  
  84.   // Application is reponsible for freeing us explicitly
  85.   FreeOnTerminate    := false;
  86.  
  87.   // Create the In and Out boxes that will function as the communication mechanism
  88.   FInBox             := TWaitableThreadList.Create;
  89.   FOutBox            := TWaitableThreadList.Create;
  90.  
  91.   // Set up event that will be called in main thread context when items are ready in the outbox
  92.   MultiThreadedMainLoop.TriggerOnObject(FOutBox, Self.ItemInOutBoxReady);
  93.  
  94.   // Now start running the thread
  95.   Suspended          := false;
  96. end;
  97.  
  98. destructor TBackgroundTasksThread.Destroy;
  99. begin
  100.   inherited Destroy;
  101.   // Note: The thread must finish executing before freeing these objects,
  102.   // so put them _after_ the inherited Destroy;
  103.   FreeObject(FInBox);
  104.   FreeObject(FOutBox);
  105. end;
  106.  
  107. procedure TBackgroundTasksThread.HandleBackgroundTask(aBackgroundTask: TBackgroundTask);
  108. begin
  109. // Assert(Assigned(aBackgroundTask));
  110.   // Perform the BackgroundTask in this low-priority thread
  111.   if Assigned(aBackgroundTask) then
  112.     aBackgroundTask.Perform;
  113.   // Now signal to other threads (usually the main thread) that a task result is ready by adding it the the outbox list
  114.   FOutBox.Add(aBackgroundTask);
  115. end;
  116.  
  117. procedure TBackgroundTasksThread.AppHandleException;
  118. begin
  119.   Application.HandleException(Self);
  120. end;
  121.  
  122. procedure TBackgroundTasksThread.Execute;
  123. const
  124.   TimeOut = 100; // Wait 0.1 sec before checking if thread is terminated
  125. begin
  126.   while not Terminated do
  127.   begin
  128.     try
  129.       if (FInBox.WaitFor(TimeOut) = wrSignaled) and not Terminated then
  130.         HandleBackgroundTask(TBackgroundTask(FInBox.Last));  // This removes the entry from the InBox list
  131.     except
  132.       Synchronize(AppHandleException); // Need to copy exception object??
  133.     end;
  134.   end;
  135. end;
  136.  
  137. // These methods runs outside the context of this thread (called from the main thread):
  138.  
  139. procedure TBackgroundTasksThread.AddBackgroundTask(aBackgroundTask: TBackgroundTask);
  140. begin
  141.   InBox.Add(aBackgroundTask);
  142. end;
  143.  
  144. procedure TBackgroundTasksThread.ItemInOutBoxReady(Sender: TObject);
  145. var
  146.   BackgroundTask: TBackgroundTask;
  147. begin
  148.   BackgroundTask := TBackgroundTask(FOutBox.Last);
  149.   BackgroundTask.Done;
  150. end;
  151.  
  152. end.
  153.