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

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

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

type TForm1 = class(TForm)
 Button1: TButton;
 Label1: TLabel;
 FontDialog1: TFontDialog;
 procedure Button1Click(Sender: TObject);
 procedure FormCreate(Sender: TObject);
public
 MyFontServer: IMyFontServer;
end;

var Form1: TForm1;

implementation

uses ActiveX, AxCtrls;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var Temp: IFontDisp;
begin
 if (FontDialog1.Execute) then begin
 Label1.Font.Assign(FontDialog1.Font);
 GetOleFont(Label1.Font, Temp);
 MyFontServer.Set_MyFont(Temp);
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 MyFontServer := CoMyFontServer.Create;
end;

end.
{--------------------------------------------------------------------}