Клиент OLE Automation, реализация класса стока событий - Delphi - Ответ 4875430

unit lbAuto_Unit;
 
{$WARN SYMBOL_PLATFORM OFF}
 
interface
 
uses  ComObj, ActiveX, AxCtrls, Classes, automsrv_TLB, StdVcl;
 
type
  TlbAuto = class(TAutoObject, IConnectionPointContainer, IlbAuto)
  private
    FConnectionPoints: TConnectionPoints;
    FConnectionPoint: TConnectionPoint;
    FEvents: IlbAutoEvents;
  public
    procedure Initialize; override;
 
  protected
    procedure AddLine(Line: OleVariant); safecall;
    procedure DeleteLine(Index: Integer); safecall;
    procedure SortLines; safecall;
    function  Get_Count: Integer; safecall;
 
    property ConnectionPoints: TConnectionPoints read FConnectionPoints
      implements IConnectionPointContainer;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
 
  end;
 
implementation
 
uses ComServ, MainServer;
 
procedure TlbAuto.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IlbAutoEvents;
end;
 
procedure TlbAuto.Initialize;
begin
  inherited Initialize;
  FConnectionPoints := TConnectionPoints.Create(Self);
  if AutoFactory.EventTypeInfo <> nil then
    FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
      AutoFactory.EventIID, ckSingle, EventConnect)
  else FConnectionPoint := nil;
 
end;
 
// далее идет описание методов для клиентских подключений
 
procedure TlbAuto.AddLine(Line: OleVariant);
var X:Integer;
begin
 frmMainServer.ListBox1.Items.Add(Line);
 X:=frmMainServer.ListBox1.Count;
 if FEvents<>nil then FEvents.OnChange(X); //здесь главное вот эта строка,
                           //она создает событие для клиента
end;
 
procedure TlbAuto.DeleteLine(Index: Integer);
var X:Integer;
begin
 frmMainServer.ListBox1.Items.Delete(Index);
 X:=frmMainServer.ListBox1.Count;
 if FEvents<>nil then FEvents.OnChange(X);
end;
 
procedure TlbAuto.SortLines;
begin
 if FEvents<>nil then FEvents.OnBeforeSort;
 frmMainServer.ListBox1.Sorted:=true;
 if FEvents<>nil then FEvents.OnAfterSort;
end;
 
function TlbAuto.Get_Count: Integer;
begin
  Result:=frmMainServer.ListBox1.Count;
end;
 
 
initialization
  TAutoObjectFactory.Create(ComServer, TlbAuto, Class_lbAuto,
    ciMultiInstance, tmApartment);
end.

unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
 
type
  TForm1 = class(TForm)
  private
  public
 
    procedure Event1 (ASender: TObject);
end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
// Событие формы OnCreate
var
  I: TInteface;
begin
    I := TInteface.Create(nil);
    I.Event1 := Event1; // здесь идет присваивание адреса функции в метод события
end;
 
procedure TForm1.Event1(ASender: TObject);
begin
// здесь я получаю событие от другого сервера
// и здесь необходимо сгенерировать событие  FEvents.OnChange(X) от моего сервера 
end;
  
end.