unit BackgrounWorker;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
 Windows, ComObj, Messages, ActiveX, AxCtrls, Classes, Dialogs, BackgrounWorkerDemo_TLB, StdVcl;

type
 TWorkerThread = class(TThread)
 protected
   procedure Execute; override;
 end;

 TBackrgoundWorker = class(TAutoObject, (*IConnectionPointContainer, *) IBackrgoundWorker)
 private
   { Private declarations }
 public
   Thread : TWorkerThread;
   destructor Destroy; override;
   procedure OnWorkTerminate(Sender : TObject);
 protected
   procedure Work; safecall;
 end;

implementation

uses ComServ;

destructor TBackrgoundWorker.Destroy;
begin
 inherited;
end;

procedure TBackrgoundWorker.OnWorkTerminate(Sender : TObject);
begin
 ShowMessage('Work Terminate');
end;

procedure TBackrgoundWorker.Work;
begin
 Thread := TWorkerThread.Create(True);
 Thread.FreeOnTerminate := True;
 Thread.OnTerminate := OnWorkTerminate;
 Thread.Start;
 { главный цикл сообщений потока }

end;

{ TWorkerThread }

procedure TWorkerThread.Execute;
var
 i: Integer;
begin
 for i := 0 to 10 do
   Sleep(100);
 //OnTerminate не вызывается, т.к. используется Synchronize
end;

initialization
 TAutoObjectFactory.Create(ComServer, TBackrgoundWorker, Class_BackrgoundWorker,
   ciMultiInstance, tmApartment);

end.

procedure TBackrgoundWorker.Work;
begin
   ...
   if( S_OK = CoMarshalInterThreadInterfaceInStream(IBackrgoundWorker, self as IBackrgoundWorker, @Thread.FMarshalStream) )then begin
      Thread.Start
   end else begin
      Thread.Free;
      raise EOleException.Create('Мне лень', E_FAIL, 'Work', '', -1);
   end;
end;

procedure TWorkerThread.Execute;
var intf: IBackrgoundWorker;
begin
   ...
   if( S_OK = CoGetInterfaceAndReleaseStream(FMarshalStream, IBackrgoundWorker, @intf) )then
      intf.DoOnWorkTerminate(...);
end;