ucorosemagic.~pas

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

unit uCoRoseMagic;

interface

uses
  ComObj, ActiveX, AxCtrls, Classes, RoseMagic_TLB, StdVcl,RationalRose_TLB,Sysutils,Forms,Dialogs;

type
  TCoRoseMagic = class(TAutoObject, IConnectionPointContainer, ICoRoseMagic)
  private
    { Private declarations }
    FConnectionPoints: TConnectionPoints;
    FConnectionPoint: TConnectionPoint;
    FSinkList: TList;
    FEvents: ICoRoseMagicEvents;
  public
    procedure Initialize; override;

    //普能构造函数
    procedure DoConstructor(var roseapp: IRoseApplication;
      var aInternalName: WideString);

    //构造函数
    procedure DoConstructor_Controller(var roseapp: IRoseApplication;
      var aInternalName: WideString);

    {新接口}
    procedure DoSetParams(oRoseOperation:IRoseOperation;S:string;Note:string);

    procedure DoSetOperation(var RoseClass: IRoseClass;OperationStr,OperationNote,ParamsNote:string);
    {新接口}


  protected
    { Protected declarations }
    property ConnectionPoints: TConnectionPoints read FConnectionPoints
      implements IConnectionPointContainer;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    function OnEnableContextMenuItems(var roseapp: IRoseApplication;
      var itemType: Smallint): WordBool; safecall;
    function OnSelectedContextMenuItem(var roseapp: IRoseApplication;
      var aInternalName: WideString): WordBool; safecall;
    procedure OnActivate(var roseapp: IRoseApplication); safecall;
    procedure OnDeactivate(var roseapp: IRoseApplication); safecall;
    procedure ShowDesignPatternManager(var roseapp: IRoseApplication); safecall;
  end;

implementation

uses ComServ,uMatch;

const C_ToolName = 'Delphi';

procedure TCoRoseMagic.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as ICoRoseMagicEvents;
  if FConnectionPoint <> nil then
     FSinkList := FConnectionPoint.SinkList;
end;

procedure TCoRoseMagic.Initialize;
begin
  inherited Initialize;
  FConnectionPoints := TConnectionPoints.Create(Self);
  if AutoFactory.EventTypeInfo <> nil then
    FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
      AutoFactory.EventIID, ckSingle, EventConnect)
  else FConnectionPoint := nil;
end;


function TCoRoseMagic.OnEnableContextMenuItems(
  var roseapp: IRoseApplication; var itemType: Smallint): WordBool;
begin
  result := true;
end;

function TCoRoseMagic.OnSelectedContextMenuItem(
  var roseapp: IRoseApplication; var aInternalName: WideString): WordBool;
begin
  if aInternalName ='constructor()' then  doConstructor(roseapp,aInternalName);
  if aInternalName ='constructor(Controller: TCommandCtrl)' then DoConstructor_Controller(roseapp,aInternalName);
end;

procedure TCoRoseMagic.OnActivate(var roseapp: IRoseApplication);
var
  oAddIn:IRoseAddIn;
  oMenuItem : IRoseContextMenuItem;
  I : integer;
begin
  for I := 1 to Roseapp.AddInManager.AddIns.count do
  begin
    oAddIn:=roseapp.AddInManager.AddIns.getat(i);
    if uppercase(oAddIn.ServerName)=uppercase('RoseMagic.CoRoseMagic') then
      break;
  end;

  try
    {Class Section}
    oMenuItem:= oAddIn.AddContextMenuItem (rsClass, 'Submenu &RoseMagic1', 'RoseMagic1');
    oMenuItem.MenuState:=rsEnabled;

    oMenuItem:=oAddIn.AddContextMenuItem (rsClass, 'constructor() &1', 'constructor()');
    oMenuItem.MenuState:=rsEnabled;

    oMenuItem:=oAddIn.AddContextMenuItem (rsClass, 'constructor(AOwner: TComponent) &2', 'constructor(AOwner: TComponent)');
    oMenuItem.MenuState:=rsEnabled;

    oMenuItem:=oAddIn.AddContextMenuItem (rsClass, 'constructor(Controller: TCommandCtrl) &3', 'constructor(Controller: TCommandCtrl)');
    oMenuItem.MenuState:=rsEnabled;

    oMenuItem:=oAddIn.AddContextMenuItem (rsClass, 'Create Component &4', 'Create Component');
    oMenuItem.MenuState:=rsEnabled;

    oMenuItem:=oAddIn.AddContextMenuItem (rsClass, 'EndSubmenu', '');
    oMenuItem.MenuState:=rsEnabled;


    oMenuItem:= oAddIn.AddContextMenuItem (rsClass, 'Submenu &RoseMagic2', 'RoseMagic2');
    oMenuItem.MenuState:=rsEnabled;
    oMenuItem:=oAddIn.AddContextMenuItem (rsClass, '&Get', 'Get2');
    oMenuItem.MenuState:=rsEnabled;
    oMenuItem:=oAddIn.AddContextMenuItem (rsClass, '&Set', 'Set2');
    oMenuItem.MenuState:=rsEnabled;
    oMenuItem:=oAddIn.AddContextMenuItem (rsClass, 'EndSubmenu', '');
    oMenuItem.MenuState:=rsEnabled;
    {Class Section}
  except
    on E:Exception do
      Application.MessageBox(Pchar(E.classname+E.message),'提示',0+64);
  end;
end;
procedure TCoRoseMagic.OnDeactivate(var roseapp: IRoseApplication);
begin
//
end;

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

procedure TCoRoseMagic.DoConstructor(var roseapp: IRoseApplication;
      var aInternalName: WideString);
var
  oRoseClass : IRoseClass;
begin
  oRoseClass := RoseApp.CurrentModel.GetSelectedItems.GetAt(1) as IRoseClass;
  if oRoseClass <> nil then
  begin
    DoSetOperation(oRoseClass,'class function test(var a:integer):string;override;','测试|描述','编号');
  end;

end;

procedure TCoRoseMagic.DoConstructor_Controller(
  var roseapp: IRoseApplication; var aInternalName: WideString);
var
  oRoseClass : IRoseClass;
  oRoseOperation : IRoseOperation;
  oRoseProperty : IRoseProperty;
  oRoseParameter : IRoseParameter;
  i : integer;
begin
  oRoseClass := RoseApp.CurrentModel.GetSelectedItems.GetAt(1) as IRoseClass;
  if oRoseClass <> nil then
  begin

    oRoseOperation := oRoseClass.AddOperation('Create','');

    oRoseOperation.AddParameter('Controller','TCommandCtrl','',0);

    oRoseOperation.Documentation := '功能:构造函数';

    oRoseProperty := oRoseOperation.FindProperty('Delphi','Operation_Kind');

    oRoseProperty.Value := 'Constructor';

    {showmessage(oRoseProperty.Name+'|'+ oRoseProperty.ToolName+'|'+oRoseProperty.Value);
    for i := 1 to oRoseOperation.GetAllProperties.Count do
    begin
      oRoseProperty := oRoseOperation.GetAllProperties.GetAt(i);
      showmessage(oRoseProperty.Name+'|'+ oRoseProperty.ToolName+'|'+oRoseProperty.Value);
      if (oRoseProperty.ToolName = 'Delphi') and  (oRoseProperty.Name= 'Operation_Kind') then
    end; }
  end;

end;

procedure TCoRoseMagic.DoSetParams(oRoseOperation:IRoseOperation; S, Note: string);
var
  tmpStr:String;
  ParamsList:TstringList;
  NoteList:TstringList;
  ParamList:TstringList;
  singleParamList:TstringList;
  I,J,K:integer;
  oParameter:IRoseParameter;
begin
  //var[1] x,y,z[2]:integer[3]=5[4];
  tmpStr:= s;
  tmpStr := MatchParams(s);
  if Length(trim(s))=0 then
    exit;

  NoteList := TstringList.Create;
  ParamsList := TstringList.create;
  ParamList := TstringList.create;
  singleParamList:=TstringList.create;
  DivideStr(tmpStr,';',ParamsList);
  DivideStr(Note,'|',NoteList);
  K := 0;

  for i := 0 to ParamsList.Count - 1 do
  begin
    if MatchSingleParam(ParamsList[i],ParamList) > -1 then
    begin
      DivideStr(ParamList[2],',',singleParamList);
      for J := 0 to singleParamList.Count - 1 do
      begin
        Inc(K);
        oParameter := oRoseOperation.AddParameter(singleParamList[J],ParamList[3],ParamList[4],k-1);
        oParameter.FindProperty(C_ToolName,'Mode').value := ParamList[1];
        if K <= NoteList.Count then
           oParameter.Documentation := NoteList[k-1];
      end;
    end;
  end;
  singleParamList.free;
  ParamsList.free;
  ParamList.free;
  NoteList.free;
end;

procedure TCoRoseMagic.DoSetOperation(var RoseClass: IRoseClass;
  OperationStr, OperationNote, ParamsNote: string);
var
  oRoseClass : IRoseClass;
  oRoseOperation : IRoseOperation;
  oRoseProperty : IRoseProperty;
  oRoseAttribute: IRoseAttribute;
  I : integer;
  stringList:TstringList;
  NoteList:TstringList;
begin
  stringList := TstringList.Create;
  NoteList := TstringList.create;
  DivideStr(OperationNote,'|',NoteList);
  oRoseClass := RoseClass;
  if oRoseClass <> nil then
  begin
    case MatchSentence(OperationStr,stringList) of
    //C_DESTRUCTOR  destructor[1] destroy[2] ;override;[3]
    0 :begin
         oRoseOperation := oRoseClass.AddOperation(stringList[2],''); //destroy[2]
         oRoseProperty := oRoseOperation.FindProperty(C_ToolName,'Operation_Kind');
         oRoseProperty.Value := 'destructor';                        // destructor[1]
         oRoseProperty := oRoseOperation.FindProperty(C_ToolName,'Operation_Binding');
         oRoseProperty.Value := stringList[3];                        //override;[3]
         //oRoseOperation.Documentation := '功能:构造函数';
     end;
    //C_CONSTRUCTOR  constructor[1] create[2](参数[3]);virtual;[4]
    1 :begin
         oRoseOperation := oRoseClass.AddOperation(stringList[2],'');  //create[2]
         oRoseProperty := oRoseOperation.FindProperty(C_ToolName,'Operation_Kind');
         oRoseProperty.Value := 'constructor';                         //constructor[1]
         oRoseProperty := oRoseOperation.FindProperty(C_ToolName,'Operation_Binding');
         oRoseProperty.Value := stringList[4];                        //virtual;[4]
         DoSetParams(oRoseOperation,stringList[3],ParamsNote) ;
       end;
    //C_FUNCTION  class[1] function[2] 名称[3] (参数[4]):返回值[5];override;[6]
    2 :begin
         oRoseOperation := oRoseClass.AddOperation(stringList[3],stringList[5]); //函数名称[3],返回值[5]
         oRoseProperty := oRoseOperation.FindProperty(C_ToolName,'Operation_Kind');
         if trim(stringList[1]) <> '' then                            //class[1]
         begin
           oRoseProperty.Value := 'class function';
         end
         else begin
           oRoseProperty.Value := 'function';
         end;
         oRoseProperty := oRoseOperation.FindProperty(C_ToolName,'Operation_Binding');
         oRoseProperty.Value := stringList[6]; //override;[6]
         DoSetParams(oRoseOperation,stringList[4],ParamsNote) ;
       end;
    //C_PROCEDURE  class[1] procedure[2] 名称[3] (参数[4]);override;[5]
    3 :begin
         oRoseOperation := oRoseClass.AddOperation(stringList[3],''); //函数名称[3]
         oRoseProperty := oRoseOperation.FindProperty(C_ToolName,'Operation_Kind');  //class[1]
         if trim(stringList[1]) <> '' then
         begin
           oRoseProperty.Value := 'class procedure';
         end
         else begin
           oRoseProperty.Value := 'procedure';
         end;
         oRoseProperty := oRoseOperation.FindProperty(C_ToolName,'Operation_Binding');
         oRoseProperty.Value := stringList[5] ;
         DoSetParams(oRoseOperation,stringList[4],ParamsNote) ;
       end;
    //C_ATTRIBUTE  AttributeName[1]:AttributeType[2];
    4 :begin
         oRoseAttribute := oRoseClass.AddAttribute(stringList[1],stringList[2],'');
       end;
    end;
    if NoteList.Count > 0 then oRoseOperation.Documentation := '功能：'+ NoteList[0];
    if NoteList.Count > 1 then oRoseOperation.Documentation := oRoseOperation.Documentation + #13#10+'描述：'+ NoteList[1];
  end;

end;

initialization
  TAutoObjectFactory.Create(ComServer, TCoRoseMagic, Class_CoRoseMagic,
    ciMultiInstance, tmApartment);
end.