unit TestUnit;

interface

uses  // код урезан
  PYCE_TLB;
 

type
 TTestForm = class(TForm)
   TestButton: TButton;
   LabelI: TLabel;
   LabelL: TLabel;
   Labelid: TLabel;
   procedure TestButtonClick(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
 public
   procedure NextIter(Sender: TObject; I, L, id: Integer);
 end;

var
 TestForm: TTestForm;
 MyObj: TYCE;
 procedure DLL_proc1  (...); cdecl; external('DLL');

implementation

{$R *.dfm}

{ TTestForm }

procedure TTestForm.NextIter(Sender: TObject; I, L, id: Integer);
begin
 LabelI.Caption := IntToStr(I);
 LabelL.Caption := IntToStr(L);
 Labelid.Caption := IntToStr(id);
 Application.ProcessMessages;
end;

procedure TTestForm.TestButtonClick(Sender: TObject);
var id, P: Integer;
begin
 try

   MyObj := TYCE.Create(self);
   MyObj.Connect;
   MyObj.OnENext := NextIter;
   
   id := MyObj.RegId;

   MyObj.GNextIter(P*25,P*35,1);  // в этом сл-е событие поднимается

 { Calling DLL-code }
   DLL_proc1(id);  //  Вызов процедуры proc1 из библиотеки DLL

 except
   LabelI.Caption := '-1';
 end;
end;

procedure TTestForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if MyObj <> nil then
MyObj.Disconnect;
end;

end.

MyObj: TYCE;

e = actxserver ('PYCE.YCE');
for i=1:100
 e.Next(i,i*10,1);
end

unit YCEUnit;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
 PYCE_TLB;

type
 TYCE = class(TAutoObject, IConnectionPointContainer, IYCE)
 private
   { Private declarations }
   FConnectionPoints: TConnectionPoints;
   FConnectionPoint: TConnectionPoint;
   FEvents: IYCEEvents;
   { note: FEvents maintains a *single* event sink. For access to more
     than one event sink, use FConnectionPoint.SinkList, and iterate
     through the list of sinks. }
 public
   procedure Initialize; override;
 protected
   { Protected declarations }
   property ConnectionPoints: TConnectionPoints read FConnectionPoints
     implements IConnectionPointContainer;
   procedure EventSinkChanged(const EventSink: IUnknown); override;
   function RegId: Integer; safecall;
   procedure Next(I, L, id: Integer); safecall;
 end;
 
implementation

uses ComServ, MainUnit; {В MainUnit-e описание формы COMForm, с public-свойствами FEvent: IYCEEvents;
                         ListOfId: TInterfaceList;
                         idCount: Integer;  
на событии COMForm.create:
                        ListOfId := TInterfaceList.Create;
                        idCount := 1;}

procedure TYCE.EventSinkChanged(const EventSink: IUnknown);
begin

 COMForm.FEvent := FEvents;

 FEvents := EventSink as IYCEEvents;

 { Сохраняем на форме }
 COMForm.FEvent := FEvents;

end;

procedure TYCE.Initialize;
begin
 inherited Initialize;
 FConnectionPoints := TConnectionPoints.Create(Self);
 if AutoFactory.EventTypeInfo <> nil then
   FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
     AutoFactory.EventIID, ckSingle, EventConnect)
 else FConnectionPoint := nil;
end;

{ Функция RegId для подсчета клиентов, нужна еще и для определения, кому пересылать событие }
function TYCE.RegId: Integer;
begin

 COMForm.ListOfId.Add(COMForm.FEvent);
 COMForm.idCount := COMForm.idCount+1;

 Result := COMForm.idCount-1;

end;

procedure TYCE.Next(I, L, id: Integer);
var
   MyFEvent: IYCEEvents;
begin

 COMForm.LabelI.Caption := IntToStr(I)+'  '+IntToStr(L)
 +'  '+IntToStr(id); //смотрю пришло ли событие
 Application.ProcessMessages;

{ Смотрим содержимое первой ячейки нашего листа ,берем Event для App1 }
 MyFEvent := IYCEEvents(COMForm.ListOfId.Items[0]);
 MyFEvent.ENext(I, L, id);

end;

initialization
 TAutoObjectFactory.Create(ComServer, TYCE, Class_YCE,
   ciMultiInstance, tmApartment);
end.

MyFEvent.ENext(I, L, id);