unit UnMyAggrObj;

interface

uses Windows, ComObj, extctrls, AggrLib_TLB;
const NumSt = 5;
type
 TMyAggrObj = class(TAggregatedObject, IMyXTimer)
  protected
   St:array[0..NumSt-1] of ITypaMyAdvise;
  public
   Timer:TTimer;
   procedure OnXTime(Sender: TObject);
   function  SetAdvise(const Advs: ITypaMyAdvise):HResult; stdcall;
   function  Unadvise(const Advs: ITypaMyAdvise): HResult; stdcall;
   function  Start: HResult; stdcall;
   function  Stop: HResult; stdcall;
   function  SetInterval(Intrerval: Integer): HResult; stdcall;
   constructor Create(Controller: IUnknown);
  end;
implementation
 uses SysUtils;
{ TMyAggrObj }

constructor TMyAggrObj.Create(Controller: IUnknown);
begin
 inherited Create(Controller);
 Timer := TTimer.Create(nil);
 Timer.Enabled := false;
 Timer.Interval := 100;
 Timer.OnTimer := OnXTime;
end;

procedure TMyAggrObj.OnXTime(Sender: TObject);
var i:integer;
begin
 for i := 0 to NumSt-1 do
  try
   if St[i]<>nil then St[i].OnXTime;
  except
   Timer.Enabled := false;
   raise Exception.Create(Format('Except i=%d, Adv=%p',[i,pointer(St[i])]));
  end;
end;

function TMyAggrObj.SetAdvise(const Advs: ITypaMyAdvise): HResult;
var i:integer;
begin
 Result := S_OK;
 for i:=0 to NumSt-1 do
  if St[i]=nil then
   begin
    St[i] := Advs;
    exit;
   end;
 Result := E_FAIL;
end;

function TMyAggrObj.Unadvise(const Advs: ITypaMyAdvise): HResult;
var i:integer;
begin
 Result := S_OK;
 for i:=0 to NumSt-1 do
  if St[i]=Advs then
   begin
    St[i] := nil;
    exit;
   end;
 Result := E_FAIL;
end;

function TMyAggrObj.Start: HResult;
begin
 Timer.Enabled := true;
 Result := S_OK;
end;

function TMyAggrObj.Stop: HResult;
begin
 Timer.Enabled := false;
 Result := S_OK;
end;

function TMyAggrObj.SetInterval(Intrerval: Integer): HResult;
begin
 Timer.Interval := Intrerval;
 Result := S_OK;
end;

end.