Советы по Delphi. Версия 1.4.3 от 1.1.2001

 { GUID'ы класса компоненты }

 Class_MyFontServer: TGUID = '{29C7AC96-0807-11D1-B2BA-0020AFF2F575}';

type

 { Предварительные объявления: Интерфейсы }

 IMyFontServer = interface;

 IMyFontServerDisp = dispinterface;

 { Предварительные объявления: CoClasse'ы }

 MyFontServer = IMyFontServer;

 { Диспинтерфейс для объекта MyFontServer }

 IMyFontServer = interface(IDispatch)['{29C7AC95-0807-11D1-B2BA-0020AFF2F575}']

  function Get_MyFont: IFontDisp; safecall;

  procedure Set_MyFont(const Value: IFontDisp); safecall;

  property MyFont: IFontDisp read Get_MyFont write Set_MyFont;

 end;

 { Объявление диспинтерфейса для дуального интерфейса IMyFontServer }

 IMyFontServerDisp = dispinterface['{29C7AC95-0807-11D1-B2BA-0020AFF2F575}']

  property MyFont: IFontDisp dispid 1;

 end;

 { MyFontServerObject }

 CoMyFontServer = class

  class function Create: IMyFontServer;

  class function CreateRemote(const MachineName: string): IMyFontServer;

 end;

implementation

uses ComObj;

class function CoMyFontServer.Create: IMyFontServer;

begin

 Result := CreateComObject(Class_MyFontServer) as IMyFontServer;

end;

class function CoMyFontServer.CreateRemote(const MachineName: string): IMyFontServer;

begin

 Result := CreateRemoteComObject(MachineName, Class_MyFontServer) as IMyFontServer;

end;

end.

{--------------------------------------------------------------------}

unit Unit1;

interface

uses ComObj, Project1_TLB, ActiveX, Graphics;

type TMyFontServer = class(TAutoObject, IMyFontServer)

private

 FFont: TFont;

public

 procedure Initialize; override;

 destructor Destroy; override;

 function Get_MyFont: IFontDisp; safecall;

 procedure Set_MyFont(const Value: IFontDisp); safecall;

end;

implementation

uses ComServ, AxCtrls, Unit2;

procedure TMyFontServer.Initialize;

begin

 inherited Initialize;

 FFont := TFont.Create;

end;

destructor TMyFontServer.Destroy;

begin

 FFont.Free;

 inherited Destroy;

end;

function TMyFontServer.Get_MyFont: IFontDisp;

begin

 FFont.Assign(Form2.Label1.Font);

 GetOleFont(FFont, Result);

end;

procedure TMyFontServer.Set_MyFont(const Value: IFontDisp);

begin

 SetOleFont(FFont, Value);

 Form2.Label1.Font.Assign(FFont);

end;

initialization

 TAutoObjectFactory.Create(ComServer, TMyFontServer, Class_MyFontServer, ciMultiInstance);

end.

{--------------------------------------------------------------------}

unit Unit2;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type TForm2 = class(TForm)

 Label1: TLabel;

end;

var Form2: TForm2;

implementation

{$R *.DFM}

end.

{--------------------------------------------------------------------}

unit FontCli1;

interface