{ 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