Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

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}']

functionGet_MyFont: IFontDisp; safecall;

procedureSet_MyFont( constValue: IFontDisp); safecall;

propertyMyFont: IFontDisp readGet_MyFont writeSet_MyFont;

end;

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

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

propertyMyFont: IFontDisp dispid1;

end;

{ MyFontServerObject }

CoMyFontServer = class

class functionCreate: IMyFontServer;

class functionCreateRemote( constMachineName: string): IMyFontServer;

end;

implementation

usesComObj;

class functionCoMyFontServer.Create: IMyFontServer;

begin

Result := CreateComObject(Class_MyFontServer) asIMyFontServer;

end;

class functionCoMyFontServer.CreateRemote( constMachineName: string): IMyFontServer;

begin

Result := CreateRemoteComObject(MachineName, Class_MyFontServer) asIMyFontServer;

end;

end.

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

unitUnit1;

interface

usesComObj, Project1_TLB, ActiveX, Graphics;

typeTMyFontServer = class(TAutoObject, IMyFontServer)

private

FFont: TFont;

public

procedureInitialize; override;

destructorDestroy; override;

functionGet_MyFont: IFontDisp; safecall;

procedureSet_MyFont( constValue: IFontDisp); safecall;

end;

implementation

usesComServ, AxCtrls, Unit2;

procedureTMyFontServer.Initialize;

begin

inheritedInitialize;

FFont := TFont.Create;

end;

destructorTMyFontServer.Destroy;

begin

FFont.Free;

inheritedDestroy;

end;

functionTMyFontServer.Get_MyFont: IFontDisp;

begin

FFont.Assign(Form2.Label1.Font);

GetOleFont(FFont, Result);

end;

procedureTMyFontServer.Set_MyFont( constValue: IFontDisp);

begin

SetOleFont(FFont, Value);

Form2.Label1.Font.Assign(FFont);

end;

initialization

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

end.

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

unitUnit2;

interface

usesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

typeTForm2 = class(TForm)

Label1: TLabel;

end;

varForm2: TForm2;

implementation

{$R *.DFM}

end.

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

unitFontCli1;

interface

usesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, StdVCL, Project1_TLB;

typeTForm1 = class(TForm)

Button1: TButton;

Label1: TLabel;

FontDialog1: TFontDialog;

procedureButton1Click(Sender: TObject);

procedureFormCreate(Sender: TObject);

public

MyFontServer: IMyFontServer;

end;

varForm1: TForm1;

implementation

usesActiveX, AxCtrls;

{$R *.DFM}

procedureTForm1.Button1Click(Sender: TObject);

varTemp: IFontDisp;

begin

if(FontDialog1.Execute) then begin

Label1.Font.Assign(FontDialog1.Font);

GetOleFont(Label1.Font, Temp);

MyFontServer.Set_MyFont(Temp);

end;

end;

procedureTForm1.FormCreate(Sender: TObject);

begin

MyFontServer := CoMyFontServer.Create;

end;

end.

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

Так для чего нам Unit1, создающий реализацию интерфейса? Интерфейс Ole, такой как, например, IFontDisp, может считаться соглашением о том, что свойства и функции будут определены в заданном формате, а функции будут реализованы как определено (для получения дополнительной информации смотри Руководство Разработчика, главу 36, «An Overview of COM» (Обзор COM). Тот факт, что интерфейс определен, не означает, что он реализован. Например, чтобы заставить определенный вами интерфейс IFontDisp быть полезным, необходимо обеспечить хранение шрифта и механизм добавления и извлечения информации об атрибутах шрифта, таких, как имя шрифта, наклонное начертание, размер и пр.