rosemagic_tlb.pas

Rose2003自定义插件开发代码示例,delphi版本

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object    : TCoAbout
// (This object is used by the IDE's Property Inspector to allow editing
//  of the properties of this server)
// *********************************************************************//
 TCoAboutProperties = class(TPersistent)
  private
    FServer:    TCoAbout;
    function    GetDefaultInterface: ICoAbout;
    constructor Create(AServer: TCoAbout);
  protected
  public
    property DefaultInterface: ICoAbout read GetDefaultInterface;
  published
  end;
{$ENDIF}


procedure Register;

implementation

uses ComObj;

class function CoCoRoseMagic.Create: ICoRoseMagic;
begin
  Result := CreateComObject(CLASS_CoRoseMagic) as ICoRoseMagic;
end;

class function CoCoRoseMagic.CreateRemote(const MachineName: string): ICoRoseMagic;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_CoRoseMagic) as ICoRoseMagic;
end;

procedure TCoRoseMagic.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{45D103D4-DD91-4B01-AE6A-D313E32DCFC3}';
    IntfIID:   '{0A3A2BE1-1212-4D52-BB77-4A84AE0EC864}';
    EventIID:  '{A0C479BA-EF6C-4FDA-BC99-97A607488EF5}';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;

procedure TCoRoseMagic.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    ConnectEvents(punk);
    Fintf:= punk as ICoRoseMagic;
  end;
end;

procedure TCoRoseMagic.ConnectTo(svrIntf: ICoRoseMagic);
begin
  Disconnect;
  FIntf := svrIntf;
  ConnectEvents(FIntf);
end;

procedure TCoRoseMagic.DisConnect;
begin
  if Fintf <> nil then
  begin
    DisconnectEvents(FIntf);
    FIntf := nil;
  end;
end;

function TCoRoseMagic.GetDefaultInterface: ICoRoseMagic;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  Result := FIntf;
end;

constructor TCoRoseMagic.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps := TCoRoseMagicProperties.Create(Self);
{$ENDIF}
end;

destructor TCoRoseMagic.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps.Free;
{$ENDIF}
  inherited Destroy;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TCoRoseMagic.GetServerProperties: TCoRoseMagicProperties;
begin
  Result := FProps;
end;
{$ENDIF}

procedure TCoRoseMagic.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
  case DispID of
    -1: Exit;  // DISPID_UNKNOWN
  end; {case DispID}
end;

procedure TCoRoseMagic.OnActivate(var roseapp: IRoseApplication);
begin
  DefaultInterface.OnActivate(roseapp);
end;

procedure TCoRoseMagic.OnDeactivate(var roseapp: IRoseApplication);
begin
  DefaultInterface.OnDeactivate(roseapp);
end;

function  TCoRoseMagic.OnEnableContextMenuItems(var roseapp: IRoseApplication; 
                                                var itemType: Smallint): WordBool;
begin
  Result := DefaultInterface.OnEnableContextMenuItems(roseapp, itemType);
end;

function  TCoRoseMagic.OnSelectedContextMenuItem(var roseapp: IRoseApplication; 
                                                 var aInternalName: WideString): WordBool;
begin
  Result := DefaultInterface.OnSelectedContextMenuItem(roseapp, aInternalName);
end;

procedure TCoRoseMagic.ShowDesignPatternManager(var roseapp: IRoseApplication);
begin
  DefaultInterface.ShowDesignPatternManager(roseapp);
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TCoRoseMagicProperties.Create(AServer: TCoRoseMagic);
begin
  inherited Create;
  FServer := AServer;
end;

function TCoRoseMagicProperties.GetDefaultInterface: ICoRoseMagic;
begin
  Result := FServer.DefaultInterface;
end;

{$ENDIF}

class function CoCoAbout.Create: ICoAbout;
begin
  Result := CreateComObject(CLASS_CoAbout) as ICoAbout;
end;

class function CoCoAbout.CreateRemote(const MachineName: string): ICoAbout;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_CoAbout) as ICoAbout;
end;

procedure TCoAbout.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{37BC1685-F3ED-401F-B90C-2F8D9B257F28}';
    IntfIID:   '{80BB5C56-A5B6-47F5-96C4-37B093147A79}';
    EventIID:  '{13065E23-E6D0-4F00-BEB2-7659A45B5E2F}';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;

procedure TCoAbout.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    ConnectEvents(punk);
    Fintf:= punk as ICoAbout;
  end;
end;

procedure TCoAbout.ConnectTo(svrIntf: ICoAbout);
begin
  Disconnect;
  FIntf := svrIntf;
  ConnectEvents(FIntf);
end;

procedure TCoAbout.DisConnect;
begin
  if Fintf <> nil then
  begin
    DisconnectEvents(FIntf);
    FIntf := nil;
  end;
end;

function TCoAbout.GetDefaultInterface: ICoAbout;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  Result := FIntf;
end;

constructor TCoAbout.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps := TCoAboutProperties.Create(Self);
{$ENDIF}
end;

destructor TCoAbout.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps.Free;
{$ENDIF}
  inherited Destroy;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TCoAbout.GetServerProperties: TCoAboutProperties;
begin
  Result := FProps;
end;
{$ENDIF}

procedure TCoAbout.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
  case DispID of
    -1: Exit;  // DISPID_UNKNOWN
  end; {case DispID}
end;

procedure TCoAbout.Start(const RoseInstant: IDispatch);
begin
  DefaultInterface.Start(RoseInstant);
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TCoAboutProperties.Create(AServer: TCoAbout);
begin
  inherited Create;
  FServer := AServer;
end;

function TCoAboutProperties.GetDefaultInterface: ICoAbout;
begin
  Result := FServer.DefaultInterface;
end;

{$ENDIF}

procedure Register;
begin
  RegisterComponents('Servers',[TCoRoseMagic, TCoAbout]);
end;

end.