понедельник, 31 октября 2016 г.

#1312. MVC. TmsmCurrentElementSynchronizeBinding. Только код

unit msmCurrentElementSynchronizeBinding;

// Модуль: "w:\common\components\gui\Garant\msm\msmCurrentElementSynchronizeBinding.pas"
// Стереотип: "SimpleClass"
// Элемент модели: "TmsmCurrentElementSynchronizeBinding" MUID: (57D1737F03CB)

{$Include w:\common\components\gui\Garant\msm\msm.inc}

interface

uses
 l3IntfUses
 , msmListToListBinding
 , msmEvents
;

type
 TmsmCurrentElementSynchronizeBinding = class(TmsmListToListBinding)
  protected
   procedure DoCurrentElementChangedEvent(anEvent: TmsmEvent);
   procedure LinkEventHandlers; override;
 end;//TmsmCurrentElementSynchronizeBinding

implementation

uses
 l3ImplUses
 , msmListAndTreeInterfaces
 //#UC START# *57D1737F03CBimpl_uses*
 //#UC END# *57D1737F03CBimpl_uses*
;

procedure TmsmCurrentElementSynchronizeBinding.DoCurrentElementChangedEvent(anEvent: TmsmEvent);
//#UC START# *57D1737F03CB_57B31D1000FA_57D1737F03CB_var*
//#UC END# *57D1737F03CB_57B31D1000FA_57D1737F03CB_var*
begin
//#UC START# *57D1737F03CB_57B31D1000FA_57D1737F03CB_impl*
 if (ModelToFire.CurrentElement = nil) then
 begin
  if (ModelToListen.CurrentElement <> nil) then
   ModelToFire.CurrentElement := ModelToListen.CurrentElement;
 end//ModelToFire.CurrentElement = nil
 else
 if not ModelToFire.CurrentElement.IsSameElementView(ModelToListen.CurrentElement) then
  ModelToFire.CurrentElement := ModelToListen.CurrentElement;
//#UC END# *57D1737F03CB_57B31D1000FA_57D1737F03CB_impl*
end;//TmsmCurrentElementSynchronizeBinding.DoCurrentElementChangedEvent

procedure TmsmCurrentElementSynchronizeBinding.LinkEventHandlers;
begin
 inherited;
 Self.LinkEventHandler(CurrentElementChangedEvent.Instance, DoCurrentElementChangedEvent);
end;//TmsmCurrentElementSynchronizeBinding.LinkEventHandlers

end.


#1311. MVC. TmsmCurrentElementShowAsListBinding. Только код

unit msmCurrentElementShowAsListBinding;

// Модуль: "w:\common\components\gui\Garant\msm\msmCurrentElementShowAsListBinding.pas"
// Стереотип: "SimpleClass"
// Элемент модели: "TmsmCurrentElementShowAsListBinding" MUID: (57B2BA6D0104)

{$Include w:\common\components\gui\Garant\msm\msm.inc}

interface

uses
 l3IntfUses
 , msmListToListBinding
 , msmEvents
;

type
 TmsmCurrentElementShowAsListBinding = class(TmsmListToListBinding)
  protected
   procedure DoCurrentElementChangedEvent(anEvent: TmsmEvent);
   procedure LinkEventHandlers; override;
 end;//TmsmCurrentElementShowAsListBinding

implementation

uses
 l3ImplUses
 , msmListAndTreeInterfaces
 //#UC START# *57B2BA6D0104impl_uses*
 //#UC END# *57B2BA6D0104impl_uses*
;

procedure TmsmCurrentElementShowAsListBinding.DoCurrentElementChangedEvent(anEvent: TmsmEvent);
//#UC START# *57B2BA6D0104_57B31D1000FA_57B2BA6D0104_var*
//#UC END# *57B2BA6D0104_57B31D1000FA_57B2BA6D0104_var*
begin
//#UC START# *57B2BA6D0104_57B31D1000FA_57B2BA6D0104_impl*
 inherited;
 Self.ModelToFire.ShowElementAsList(Self.ModelToListen.CurrentElement);
//#UC END# *57B2BA6D0104_57B31D1000FA_57B2BA6D0104_impl*
end;//TmsmCurrentElementShowAsListBinding.DoCurrentElementChangedEvent

procedure TmsmCurrentElementShowAsListBinding.LinkEventHandlers;
begin
 inherited;
 Self.LinkEventHandler(CurrentElementChangedEvent.Instance, DoCurrentElementChangedEvent);
end;//TmsmCurrentElementShowAsListBinding.LinkEventHandlers

end.

#1310. MVC. TmsmViewController. Только код

unit msmViewController;

// Модуль: "w:\common\components\gui\Garant\msm\msmViewController.pas"
// Стереотип: "SimpleClass"
// Элемент модели: "TmsmViewController" MUID: (57AB0A810292)

{$Include w:\common\components\msm.inc}

interface

uses
 l3IntfUses
 , msmController
 , msmControllers
 {$If NOT Defined(NoVCL)}
 , Menus
 {$IfEnd} // NOT Defined(NoVCL)
 , msmModels
;

type
 TmsmViewController = class(TmsmController, ImsmViewController)
  private
   f_PopupMenu: TPopupMenu;
   f_View: TmsmView;
  protected
   procedure Cleanup; override;
    {* Функция очистки полей объекта. }
   procedure InitFields; override;
   procedure DoActivated; override;
  public
   constructor Create(aView: TmsmView;
    const aModel: ImsmModel); reintroduce;
   class function Make(aView: TmsmView;
    const aModel: ImsmModel): ImsmViewController; reintroduce;
  protected
   property View: TmsmView
    read f_View;
 end;//TmsmViewController

implementation

uses
 l3ImplUses
 , msmOperations
 , Classes
 {$If NOT Defined(NoScripts)}
 , TtfwClassRef_Proxy
 {$IfEnd} // NOT Defined(NoScripts)
 //#UC START# *57AB0A810292impl_uses*
 , SysUtils
 //#UC END# *57AB0A810292impl_uses*
;

type
 TmsmOperationMenuItem = class({$If NOT Defined(NoVCL)}
 TMenuItem
 {$IfEnd} // NOT Defined(NoVCL)
 )
  private
   f_Operation: ImsmOperation;
  protected
   {$If NOT Defined(NoVCL)}
   procedure Click; override;
   {$IfEnd} // NOT Defined(NoVCL)
   {$If NOT Defined(NoVCL)}
   procedure InitiateAction; override;
   {$IfEnd} // NOT Defined(NoVCL)
  public
   constructor Create(anOwner: TComponent;
    const anOperation: ImsmOperation); reintroduce;
   destructor Destroy; override;
 end;//TmsmOperationMenuItem

 TmsmViewFriend = {abstract} class(TmsmView)
  {* Друг к классу TmsmView }
 end;//TmsmViewFriend

constructor TmsmOperationMenuItem.Create(anOwner: TComponent;
 const anOperation: ImsmOperation);
//#UC START# *57CECAC202FB_57CECA080010_var*
//#UC END# *57CECAC202FB_57CECA080010_var*
begin
//#UC START# *57CECAC202FB_57CECA080010_impl*
 Assert(anOperation <> nil);
 inherited Create(anOwner);
 f_Operation := anOperation;
 Self.Action := f_Operation.Action;
 //Self.Caption := anOperation.Caption;
//#UC END# *57CECAC202FB_57CECA080010_impl*
end;//TmsmOperationMenuItem.Create

destructor TmsmOperationMenuItem.Destroy;
//#UC START# *48077504027E_57CECA080010_var*
//#UC END# *48077504027E_57CECA080010_var*
begin
//#UC START# *48077504027E_57CECA080010_impl*
 f_Operation := nil;
 inherited;
//#UC END# *48077504027E_57CECA080010_impl*
end;//TmsmOperationMenuItem.Destroy

{$If NOT Defined(NoVCL)}
procedure TmsmOperationMenuItem.Click;
//#UC START# *57CECDB70264_57CECA080010_var*
//#UC END# *57CECDB70264_57CECA080010_var*
begin
//#UC START# *57CECDB70264_57CECA080010_impl*
 inherited;
 //f_Operation.DoIt;
//#UC END# *57CECDB70264_57CECA080010_impl*
end;//TmsmOperationMenuItem.Click
{$IfEnd} // NOT Defined(NoVCL)

{$If NOT Defined(NoVCL)}
procedure TmsmOperationMenuItem.InitiateAction;
//#UC START# *57EB857E015E_57CECA080010_var*
var
 l_Popup : Boolean;
//#UC END# *57EB857E015E_57CECA080010_var*
begin
//#UC START# *57EB857E015E_57CECA080010_impl*
 l_Popup := (GetParentMenu Is TPopupMenu);
 inherited;
 // Не показываем в контекстном меню не доступные операции. Вызывать нужно
 // обязательно после inherited (Action.Update) когда состояние пункта меню
 // станет актуальным:
 if l_Popup then
 begin
  if Self.Enabled then
   Self.Visible := true
  else
   Self.Visible := false;
 end;//l_Popup
//#UC END# *57EB857E015E_57CECA080010_impl*
end;//TmsmOperationMenuItem.InitiateAction
{$IfEnd} // NOT Defined(NoVCL)

constructor TmsmViewController.Create(aView: TmsmView;
 const aModel: ImsmModel);
//#UC START# *57AB0AD803AD_57AB0A810292_var*
//#UC END# *57AB0AD803AD_57AB0A810292_var*
begin
//#UC START# *57AB0AD803AD_57AB0A810292_impl*
 Assert(aView <> nil);
 Assert(aModel <> nil);
 inherited Create(aModel);
 f_View := aView;
//#UC END# *57AB0AD803AD_57AB0A810292_impl*
end;//TmsmViewController.Create

class function TmsmViewController.Make(aView: TmsmView;
 const aModel: ImsmModel): ImsmViewController;
var
 l_Inst : TmsmViewController;
begin
 l_Inst := Create(aView, aModel);
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;//TmsmViewController.Make

procedure TmsmViewController.Cleanup;
 {* Функция очистки полей объекта. }
//#UC START# *479731C50290_57AB0A810292_var*
//#UC END# *479731C50290_57AB0A810292_var*
begin
//#UC START# *479731C50290_57AB0A810292_impl*
 inherited;
 if (f_PopupMenu = TmsmViewFriend(View).PopupMenu) then
  TmsmViewFriend(View).PopupMenu := nil;
 FreeAndNil(f_PopupMenu); 
 f_View := nil;
//#UC END# *479731C50290_57AB0A810292_impl*
end;//TmsmViewController.Cleanup

procedure TmsmViewController.InitFields;
//#UC START# *47A042E100E2_57AB0A810292_var*
//#UC END# *47A042E100E2_57AB0A810292_var*
begin
//#UC START# *47A042E100E2_57AB0A810292_impl*
 inherited;
//#UC END# *47A042E100E2_57AB0A810292_impl*
end;//TmsmViewController.InitFields

procedure TmsmViewController.DoActivated;
//#UC START# *57CEC64E0063_57AB0A810292_var*
var
 l_Item : TMenuItem;
 l_Index : Integer;
//#UC END# *57CEC64E0063_57AB0A810292_var*
begin
//#UC START# *57CEC64E0063_57AB0A810292_impl*
 inherited;
 if not OperationsList.Empty then
 begin
  f_PopupMenu := TPopupMenu.Create(nil{View});
  for l_Index := 0 to Pred(OperationsList.Count) do
  begin
   l_Item := TmsmOperationMenuItem.Create(f_PopupMenu, OperationsList[l_Index]);
   f_PopupMenu.Items.Add(l_Item);
  end;//for l_Index
  TmsmViewFriend(View).PopupMenu := f_PopupMenu;
 end;//not OperationsList.Empty
//#UC END# *57CEC64E0063_57AB0A810292_impl*
end;//TmsmViewController.DoActivated

initialization
{$If NOT Defined(NoScripts)}
 TtfwClassRef.Register(TmsmOperationMenuItem);
 {* Регистрация TmsmOperationMenuItem }
{$IfEnd} // NOT Defined(NoScripts)

end.

#1309. MVC. TmsmController. Только код

unit msmController;

// Модуль: "w:\common\components\gui\Garant\msm\msmController.pas"
// Стереотип: "SimpleClass"
// Элемент модели: "TmsmController" MUID: (57B1F28B030D)

{$Include w:\common\components\msm.inc}

interface

uses
 l3IntfUses
 , l3ProtoObject
 , msmControllers
 , msmModels
 , msmEvents
 , msmOperations
 , msmOperationsList
 , msmEventList
 , msmEventHandlers
;

type
 _msmOperationsManaging_Parent_ = Tl3ProtoObject;
 {$Include w:\common\components\gui\Garant\msm\msmOperationsManaging.imp.pas}
 _msmEventsSubscriber_Parent_ = _msmOperationsManaging_;
 {$Include w:\common\components\gui\Garant\msm\msmEventsSubscriber.imp.pas}
 TmsmController = class(_msmEventsSubscriber_, ImsmController)
  private
   f_Model: ImsmModel;
  protected
   procedure DoActivate; virtual;
   procedure LinkDataToView; virtual;
   procedure DoActivated; virtual;
   function As_ImsmEventsSubscriber: ImsmEventsSubscriber;
    {* Метод приведения нашего интерфейса к ImsmEventsSubscriber }
   function Get_Model: ImsmModel;
   function Publisher: ImsmEventsPublisher; override;
   procedure Cleanup; override;
    {* Функция очистки полей объекта. }
   procedure InitFields; override;
   procedure ClearFields; override;
  public
   constructor Create(const aModel: ImsmModel); reintroduce;
   class function Make(const aModel: ImsmModel): ImsmController; reintroduce;
   procedure Activate;
   procedure Activated;
  protected
   property Model: ImsmModel
    read f_Model;
 end;//TmsmController

implementation

uses
 l3ImplUses
 , SysUtils
 , msmNullOperationsList
 //#UC START# *57B1F28B030Dimpl_uses*
 //#UC END# *57B1F28B030Dimpl_uses*
;

{$Include w:\common\components\gui\Garant\msm\msmOperationsManaging.imp.pas}

{$Include w:\common\components\gui\Garant\msm\msmEventsSubscriber.imp.pas}

procedure TmsmController.DoActivate;
//#UC START# *57B1ABC80368_57B1F28B030D_var*
//#UC END# *57B1ABC80368_57B1F28B030D_var*
begin
//#UC START# *57B1ABC80368_57B1F28B030D_impl*
//#UC END# *57B1ABC80368_57B1F28B030D_impl*
end;//TmsmController.DoActivate

constructor TmsmController.Create(const aModel: ImsmModel);
//#UC START# *57B1F34803E0_57B1F28B030D_var*
//#UC END# *57B1F34803E0_57B1F28B030D_var*
begin
//#UC START# *57B1F34803E0_57B1F28B030D_impl*
 Assert(aModel <> nil);
 f_Model := aModel;
 inherited Create;
//#UC END# *57B1F34803E0_57B1F28B030D_impl*
end;//TmsmController.Create

class function TmsmController.Make(const aModel: ImsmModel): ImsmController;
var
 l_Inst : TmsmController;
begin
 l_Inst := Create(aModel);
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;//TmsmController.Make

procedure TmsmController.LinkDataToView;
//#UC START# *57B6A49900F4_57B1F28B030D_var*
//#UC END# *57B6A49900F4_57B1F28B030D_var*
begin
//#UC START# *57B6A49900F4_57B1F28B030D_impl*
//#UC END# *57B6A49900F4_57B1F28B030D_impl*
end;//TmsmController.LinkDataToView

procedure TmsmController.DoActivated;
//#UC START# *57CEC64E0063_57B1F28B030D_var*
//#UC END# *57CEC64E0063_57B1F28B030D_var*
begin
//#UC START# *57CEC64E0063_57B1F28B030D_impl*
//#UC END# *57CEC64E0063_57B1F28B030D_impl*
end;//TmsmController.DoActivated

function TmsmController.As_ImsmEventsSubscriber: ImsmEventsSubscriber;
 {* Метод приведения нашего интерфейса к ImsmEventsSubscriber }
begin
 Result := Self;
end;//TmsmController.As_ImsmEventsSubscriber

function TmsmController.Get_Model: ImsmModel;
//#UC START# *57ADBECA0388_57B1F28B030Dget_var*
//#UC END# *57ADBECA0388_57B1F28B030Dget_var*
begin
//#UC START# *57ADBECA0388_57B1F28B030Dget_impl*
 Result := f_Model;
//#UC END# *57ADBECA0388_57B1F28B030Dget_impl*
end;//TmsmController.Get_Model

procedure TmsmController.Activate;
//#UC START# *57B1AB98014B_57B1F28B030D_var*
//#UC END# *57B1AB98014B_57B1F28B030D_var*
begin
//#UC START# *57B1AB98014B_57B1F28B030D_impl*
 DoActivate;
//#UC END# *57B1AB98014B_57B1F28B030D_impl*
end;//TmsmController.Activate

procedure TmsmController.Activated;
//#UC START# *57B6A3EF0191_57B1F28B030D_var*
//#UC END# *57B6A3EF0191_57B1F28B030D_var*
begin
//#UC START# *57B6A3EF0191_57B1F28B030D_impl*
 LinkDataToView;
 DoActivated;
//#UC END# *57B6A3EF0191_57B1F28B030D_impl*
end;//TmsmController.Activated

function TmsmController.Publisher: ImsmEventsPublisher;
//#UC START# *57B6B9CD03B7_57B1F28B030D_var*
//#UC END# *57B6B9CD03B7_57B1F28B030D_var*
begin
//#UC START# *57B6B9CD03B7_57B1F28B030D_impl*
 Result := Model.As_ImsmEventsPublisher;
//#UC END# *57B6B9CD03B7_57B1F28B030D_impl*
end;//TmsmController.Publisher

procedure TmsmController.Cleanup;
 {* Функция очистки полей объекта. }
//#UC START# *479731C50290_57B1F28B030D_var*
//#UC END# *479731C50290_57B1F28B030D_var*
begin
//#UC START# *479731C50290_57B1F28B030D_impl*
 inherited;
//#UC END# *479731C50290_57B1F28B030D_impl*
end;//TmsmController.Cleanup

procedure TmsmController.InitFields;
//#UC START# *47A042E100E2_57B1F28B030D_var*
//#UC END# *47A042E100E2_57B1F28B030D_var*
begin
//#UC START# *47A042E100E2_57B1F28B030D_impl*
 Assert(Model <> nil);
 inherited;
//#UC END# *47A042E100E2_57B1F28B030D_impl*
end;//TmsmController.InitFields

procedure TmsmController.ClearFields;
begin
 f_Model := nil;
 inherited;
end;//TmsmController.ClearFields

end.

#1308. MVC. TmsmAddElement. Только код

unit msmAddElement;

// Модуль: "w:\common\components\gui\Garant\msm\msmAddElement.pas"
// Стереотип: "SimpleClass"
// Элемент модели: "TmsmAddElement" MUID: (57F50186039F)

{$Include w:\common\components\gui\Garant\msm\msm.inc}

interface

uses
 l3IntfUses
 , msmListLikeOperation
 , msmModelElementSelectService
 {$If NOT Defined(NoScripts)}
 , tfwScriptingInterfaces
 {$IfEnd} // NOT Defined(NoScripts)
 , msmModelElements
 , msmOperations
;

type
 TmsmAddElement = class(TmsmListLikeOperation, ImsmElementSelector)
  protected
   procedure DoDoIt; override;
   function GetEnabled: Boolean; override;
   procedure SelectElement(const anElementName: AnsiString;
    const anElementStereotype: ImsmModelElement;
    const aKeyValues: ItfwArray);
   function SelectFormCaption: AnsiString;
   function KeyValues: ItfwArray;
   procedure InitOperationParams(var theParams: TmsmOperationParams); override;
 end;//TmsmAddElement

implementation

uses
 l3ImplUses
 //#UC START# *57F50186039Fimpl_uses*
 , msmConcreteModels
 , msmListAndTreeViewUtils
 , msmListModel
 , msmElementViews
 //#UC END# *57F50186039Fimpl_uses*
;

procedure TmsmAddElement.DoDoIt;
//#UC START# *57CEB1F602D1_57F50186039F_var*
//#UC END# *57CEB1F602D1_57F50186039F_var*
begin
//#UC START# *57CEB1F602D1_57F50186039F_impl*
 TmsmModelElementSelectService.Instance.SelectElement(Self);
//#UC END# *57CEB1F602D1_57F50186039F_impl*
end;//TmsmAddElement.DoDoIt

function TmsmAddElement.GetEnabled: Boolean;
//#UC START# *57EB6D020381_57F50186039F_var*
//#UC END# *57EB6D020381_57F50186039F_var*
begin
//#UC START# *57EB6D020381_57F50186039F_impl*
 Result := Model.CanAddNewElement;
//#UC END# *57EB6D020381_57F50186039F_impl*
end;//TmsmAddElement.GetEnabled

procedure TmsmAddElement.SelectElement(const anElementName: AnsiString;
 const anElementStereotype: ImsmModelElement;
 const aKeyValues: ItfwArray);
//#UC START# *57F509AC007F_57F50186039F_var*
//#UC END# *57F509AC007F_57F50186039F_var*
begin
//#UC START# *57F509AC007F_57F50186039F_impl*
 Model.AddNewElement(anElementName, anElementStereotype, aKeyValues);
//#UC END# *57F509AC007F_57F50186039F_impl*
end;//TmsmAddElement.SelectElement

function TmsmAddElement.SelectFormCaption: AnsiString;
//#UC START# *57FB8665023E_57F50186039F_var*
//#UC END# *57FB8665023E_57F50186039F_var*
begin
//#UC START# *57FB8665023E_57F50186039F_impl*
 Result := 'New element';
//#UC END# *57FB8665023E_57F50186039F_impl*
end;//TmsmAddElement.SelectFormCaption

function TmsmAddElement.KeyValues: ItfwArray;
//#UC START# *57FB86B0027E_57F50186039F_var*
//#UC END# *57FB86B0027E_57F50186039F_var*
begin
//#UC START# *57FB86B0027E_57F50186039F_impl*
 Result := Model.PropertiesForNewElement;
//#UC END# *57FB86B0027E_57F50186039F_impl*
end;//TmsmAddElement.KeyValues

procedure TmsmAddElement.InitOperationParams(var theParams: TmsmOperationParams);
//#UC START# *57EBADA9033E_57F50186039F_var*
//#UC END# *57EBADA9033E_57F50186039F_var*
begin
//#UC START# *57EBADA9033E_57F50186039F_impl*
 inherited;
 theParams.rImageIndex := 58;
 theParams.SetShortCut('Ins');
//#UC END# *57EBADA9033E_57F50186039F_impl*
end;//TmsmAddElement.InitOperationParams

end.

#1307. MVC. TmsmPaste. Только код

unit msmPaste;

// Модуль: "w:\common\components\gui\Garant\msm\msmPaste.pas"
// Стереотип: "SimpleClass"
// Элемент модели: "TmsmPaste" MUID: (57E28018005C)

{$Include w:\common\components\gui\Garant\msm\msm.inc}

interface

uses
 l3IntfUses
 , msmListLikeOperation
 , msmOperations
;

type
 TmsmPaste = class(TmsmListLikeOperation)
  protected
   procedure DoDoIt; override;
   function GetEnabled: Boolean; override;
   procedure InitOperationParams(var theParams: TmsmOperationParams); override;
 end;//TmsmPaste

implementation

uses
 l3ImplUses
 , msmConcreteModels
 //#UC START# *57E28018005Cimpl_uses*
 , SysUtils
 , l3Interfaces
 , l3SysUtils
 , l3Base
 //#UC END# *57E28018005Cimpl_uses*
;

procedure TmsmPaste.DoDoIt;
//#UC START# *57CEB1F602D1_57E28018005C_var*
var
 l_IData : IDataObject;
 l_Sel : ImsmElementSelection;
//#UC END# *57CEB1F602D1_57E28018005C_var*
begin
//#UC START# *57CEB1F602D1_57E28018005C_impl*
 if not l3IFail(OleGetClipboard(l_IData)) then
  try
   if Supports(l_IData, ImsmElementSelection, l_Sel) then
    try
     Self.Model.Paste(l_Sel);
    finally
     l_Sel := nil;
    end;//try..finally
  finally
   l_IData := nil;
  end;//try..finally
//#UC END# *57CEB1F602D1_57E28018005C_impl*
end;//TmsmPaste.DoDoIt

function TmsmPaste.GetEnabled: Boolean;
//#UC START# *57EB6D020381_57E28018005C_var*
var
 l_IData : IDataObject;
 l_Sel : ImsmElementSelection;
//#UC END# *57EB6D020381_57E28018005C_var*
begin
//#UC START# *57EB6D020381_57E28018005C_impl*
 Result := false;
 if not l3IFail(OleGetClipboard(l_IData)) then
  try
   if Supports(l_IData, ImsmElementSelection, l_Sel) then
    try
     Result := Self.Model.CanPaste(l_Sel);
    finally
     l_Sel := nil;
    end;//try..finally
  finally
   l_IData := nil;
  end;//try..finally
//#UC END# *57EB6D020381_57E28018005C_impl*
end;//TmsmPaste.GetEnabled

procedure TmsmPaste.InitOperationParams(var theParams: TmsmOperationParams);
//#UC START# *57EBADA9033E_57E28018005C_var*
//#UC END# *57EBADA9033E_57E28018005C_var*
begin
//#UC START# *57EBADA9033E_57E28018005C_impl*
 inherited;
 theParams.rImageIndex := 10;
 theParams.SetShortCut('Ctrl+V');
//#UC END# *57EBADA9033E_57E28018005C_impl*
end;//TmsmPaste.InitOperationParams

end.


#1306. MVC. TmsmDrawingUseCaseView. Только код

unit msmDrawingUseCaseView;

// Модуль: "w:\common\components\gui\Garant\msm\msmDrawingUseCaseView.pas"
// Стереотип: "SimpleClass"
// Элемент модели: "TmsmDrawingUseCaseView" MUID: (57D2DF7E00CE)

{$Include w:\common\components\gui\Garant\msm\msm.inc}

interface

uses
 l3IntfUses
 , msmConcreteUseCases
 , msmControllers
 , msmUseCase
 , msmUseCases
 //#UC START# *57D2DF7E00CEintf_uses*
 //#UC END# *57D2DF7E00CEintf_uses*
;

type
 //#UC START# *57D2DF7E00CEci*
 //#UC END# *57D2DF7E00CEci*
 _ConcreteUseCase_ = ImsmDrawingUseCase;
 {$Define l3Items_IsProto}
 {$Include w:\common\components\gui\Garant\msm\msmUseCaseView.imp.pas}
 //#UC START# *57D2DF7E00CEcit*
 //#UC END# *57D2DF7E00CEcit*
 TmsmDrawingUseCaseView = class(_msmUseCaseView_, ImsmDrawingUseCaseView)
  protected
   procedure Cleanup; override;
    {* Функция очистки полей объекта. }
   procedure DoActivate; override;
   procedure DoActivated; override;
  public
   constructor Create(const aUseCase: ImsmDrawingUseCase;
    const aMainZone: ImsmViewParent;
    const aChildZone: ImsmViewParent;
    const aLeftZone: ImsmViewParent;
    const aFloatingZone: ImsmViewParent;
    const aTopZone: ImsmViewParent); reintroduce;
   class function Make(const aUseCase: ImsmDrawingUseCase;
    const aMainZone: ImsmViewParent;
    const aChildZone: ImsmViewParent;
    const aLeftZone: ImsmViewParent;
    const aFloatingZone: ImsmViewParent;
    const aTopZone: ImsmViewParent): ImsmDrawingUseCaseView; reintroduce;
 //#UC START# *57D2DF7E00CEpubl*
 //#UC END# *57D2DF7E00CEpubl*
 end;//TmsmDrawingUseCaseView

implementation

uses
 l3ImplUses
 , msmParentedViewControllerWithOwnership
 , msmModel
 , msmPanel
 , msmProportionalPanel
 , msmGenerateElement
 , msmSaveChangedElements
 , msmCopySelection
 , msmPaste
 , msmWordsManaging
 , msmSomeWordsListModel
 , msmSomeModelElementsListModel
 , msmSomeModelElementsList
 , msmMultiPanelViewParentHorz
 , msmMultiPanelViewParentVert
 , msmMultiPanelViewParent
 , msmButtonEditViewController
 , msmAddElement
 , msmDeleteSelection
 , msmChangeProperties
 , msmChangePropertiesBinding
 , msmLoadedWordsListModel
 , l3Memory
 //#UC START# *57D2DF7E00CEimpl_uses*
 , SysUtils
 , msmOpenInNewWindow
 , msmShowInNavigator
 , msmUpToParent
 , msmOperationsSeparator
 , msmListAndTreeInterfaces
 , msmListAndTreeViewUtils
 , msmCurrentElementShowAsListBinding
 , msmListOpener
 , msmListModel
 , msmListViewController
 , msmElementViews
 , msmDrawingViewController
 , msmTreeViewController
 , msmParentedViewController
 , msmModelElement
 , msmConcreteModels
 , msmListOwnerShowAsListBinding
 //#UC END# *57D2DF7E00CEimpl_uses*
;

type _Instance_R_ = TmsmDrawingUseCaseView;

{$Include w:\common\components\gui\Garant\msm\msmUseCaseView.imp.pas}

constructor TmsmDrawingUseCaseView.Create(const aUseCase: ImsmDrawingUseCase;
 const aMainZone: ImsmViewParent;
 const aChildZone: ImsmViewParent;
 const aLeftZone: ImsmViewParent;
 const aFloatingZone: ImsmViewParent;
 const aTopZone: ImsmViewParent);
//#UC START# *57D2DFA70064_57D2DF7E00CE_var*

 function AddNavigatorOperations(const aController: ImsmController; const aModel: ImsmListLikeModel): ImsmController;
 begin//AddNavigatorOperations
  aController.AddOperation(TmsmOpenInNewWindow.Make('Open in new window', aModel));
  aController.AddOperation(TmsmOperationsSeparator.Make);
  aController.AddOperation(TmsmGenerateElement.Make('Generate element', aModel));
  aController.AddOperation(TmsmOperationsSeparator.Make);
  aController.AddOperation(TmsmSaveChangedElements.Make('Save changed', aModel));
  aController.AddOperation(TmsmOperationsSeparator.Make);
  aController.AddOperation(TmsmCopySelection.Make('Copy', aModel));
  aController.AddOperation(TmsmPaste.Make('Paste', aModel));
  aController.AddOperation(TmsmDeleteSelection.Make('Delete', aModel));
  aController.AddOperation(TmsmOperationsSeparator.Make);
  aController.AddOperation(TmsmAddElement.Make('Add element', aModel));
  aController.AddOperation(TmsmOperationsSeparator.Make);
  aController.AddOperation(TmsmChangeProperties.Make('Properties', aModel));
  Result := aController;
 end;//AddNavigatorOperations

 function AddReadonlyListOperations(const aController: ImsmController; const aModel: ImsmListLikeModel): ImsmController;
 begin//
  Assert(aUseCase.FloatingNavigator <> nil);
  AddNavigatorOperations(aController, aModel);
  aController.AddOperation(TmsmOperationsSeparator.Make);
  aController.AddOperation(TmsmShowInNavigator.Make('Show in navigator', aModel, aUseCase.FloatingNavigator));
  Result := aController;
 end;//AddReadonlyListOperations

 function AddListLikeOperations(const aController: ImsmController; const aModel: ImsmListLikeModel): ImsmController;
 begin//AddListLikeOperations
  AddReadonlyListOperations(aController, aModel);
  Result := aController;
 end;//AddListLikeOperations

 function AddListOperations(const aController: ImsmController; const aModel: ImsmListModel): ImsmController;
 begin//AddListOperations
  AddListLikeOperations(aController, aModel);
  Result := aController;
 end;//AddListOperations

 function AddMainListOperations(const aController: ImsmController; const aModel: ImsmListModel): ImsmController;
 begin//AddMainListOperations
  aController.AddOperation(TmsmUpToParent.Make('Up to parent', aModel));
  aController.AddOperation(TmsmOperationsSeparator.Make);
  AddListOperations(aController, aModel);
  Result := aController;
 end;//AddMainListOperations

 function AddDiagramOperations(const aController: ImsmController; const aModel: ImsmDrawingModel): ImsmController;
 begin//AddDiagramOperations
  aController.AddOperation(TmsmUpToParent.Make('Parent diagram', aModel));
  aController.AddOperation(TmsmOperationsSeparator.Make);
  AddListOperations(aController, aModel);
  Result := aController;
 end;//AddDiagramOperations

 function DisableActionElementEvent(const aController: ImsmController): ImsmController;
 begin//DisableActionElementEvent
  aController.DisableEvent(ActionElementEvent.Instance);
  Result := aController;
 end;//DisableActionElementEvent

 procedure AddChildView(const aChildModel: ImsmListModel; const aParent: ImsmViewParent; const aContext: TmsmListViewtInitContext); overload;
 begin//AddChildView
  Bind(TmsmCurrentElementShowAsListBinding.Make(aUseCase.MainList, aChildModel));
  Bind(TmsmCurrentElementShowAsListBinding.Make(aUseCase.Drawing, aChildModel));
  Bind(TmsmChangePropertiesBinding.Make(aChildModel));
  //Bind(TmsmListOpener.Make(aChildModel, aUseCase.MainList));

  AddController(
   AddListOperations
   (
    DisableActionElementEvent
    (
     TmsmListViewController.Make(aChildModel, aParent, aContext)
    )
    , aChildModel
   )
  );
 end;//AddChildView

 procedure AddChildView(const aView: TmsmModelElementView; const aParent: ImsmViewParent; const aContext: TmsmListViewtInitContext); overload;
 begin//AddChildView
  AddChildView(TmsmListModel.MakeListForViewed(aView), aParent, aContext);
 end;//AddChildView

 procedure AddChildView(const aName: String; const aParent: ImsmViewParent; const aContext: TmsmListViewtInitContext); overload;
 begin//AddChildView
  AddChildView(TmsmModelElementView_C(aName), aParent, aContext);
 end;//AddChildView

 procedure AddChildViews(const aNames: array of String; const aParent: ImsmViewParent; const aContext: TmsmListViewtInitContext);
 var
  l_Index : Integer;
 begin//AddChildViews
  for l_Index := Low(aNames) to High(aNames) do
   AddChildView(aNames[l_Index], aParent, aContext);
 end;//AddChildViews
 
var
 l_ListContext : TmsmListViewtInitContext;
 l_DrawingZone : ImsmViewParent;
 l_AllWords : ImsmListModel;
 l_NavigatorZone : ImsmViewParent;
//#UC END# *57D2DFA70064_57D2DF7E00CE_var*
begin
//#UC START# *57D2DFA70064_57D2DF7E00CE_impl*
 inherited Create(aUseCase);
(* aUseCase.AddController(
  TmsmMainFormController.Make(Self, aUseCase.Caption)
 );*)

 l_DrawingZone := TmsmMultiPanelViewParentHorz.Make(
  BindViewParentToModelAndZone(
   AddViewParentForRelease(TmsmProportionalPanel.Create(nil))
   , aUseCase.Drawing, aMainZone
  )
 );

 AddController(
  AddDiagramOperations
  (
   TmsmDrawingViewController.Make(aUseCase.Drawing, l_DrawingZone)
   , aUseCase.Drawing
  )
 );

 AddController(
  AddMainListOperations
  (
   DisableActionElementEvent
   (
    TmsmListViewController.Make(aUseCase.Drawing, l_DrawingZone)
   )
   , aUseCase.Drawing
  )
 );

 AddController(
  AddMainListOperations
  (
   DisableActionElementEvent
   (
    TmsmListViewController.Make(aUseCase.MainList, aMainZone)
   )
   , aUseCase.MainList
  )
 );

 if (aLeftZone <> nil) then
 begin
  AddController(
   AddListLikeOperations
   (
    TmsmTreeViewController.Make(aUseCase.Navigator, aLeftZone)
    , aUseCase.Navigator
   )
  );
 end;//aLeftZone <> nil

 if (aChildZone <> nil) then
 begin
  l_ListContext := TmsmListViewtInitContext_C;
  AddChildViews(['Depends', 'Inherits', 'Implements', {'Inner',} 'Children', 'Constants', 'Attributes', 'Operations', 'Dependencies', 'Implemented', 'Overridden', 'Parameters'],
                aChildZone,
                l_ListContext
                );
  if false then
  begin
   AddChildView(TmsmModelElementView_C('UpList', 'UpText'),
                aChildZone,
                l_ListContext);
  end;//false
  if false then
  begin
   l_ListContext := TmsmListViewtInitContext_C;
   l_ListContext.rMultiStrokeItem := true;
   AddChildView(TmsmModelElementView_C('SelfList', 'DocumentationNotEmpty'),
                aChildZone,
                l_ListContext);
  end;//false
 end;//aChildZone <> nil

 if (aFloatingZone <> nil) then
 begin
  l_NavigatorZone := TmsmMultiPanelViewParentVert.Make(
   BindViewParentToModelAndZone(
    AddViewParentForRelease(TmsmProportionalPanel.Create(nil))
    , aUseCase.FloatingNavigator, aFloatingZone
   )
  );

  AddController(
   AddListLikeOperations(
   //AddNavigatorOperations(
    TmsmTreeViewController.Make(aUseCase.FloatingNavigator, l_NavigatorZone),
    aUseCase.FloatingNavigator
   )
  );

  AddController(
   AddReadonlyListOperations(
    DisableActionElementEvent
    (
     TmsmListViewController.Make(aUseCase.FoundElements, l_NavigatorZone)
    )
    , aUseCase.FoundElements
   )
  );

  if true{false} then
  begin
   l_AllWords := TmsmLoadedWordsListModel.Make;
   AddController(
    AddReadonlyListOperations(
     DisableActionElementEvent
     (
      TmsmListViewController.Make(l_AllWords, aFloatingZone)
     )
     , l_AllWords
    )
   );
   // - список всех слов модели
   Bind(TmsmListOpener.Make(l_AllWords, aUseCase.MainList));
  end;//false
  
  if true{false} then
  begin
   l_AllWords := TmsmSomeWordsListModel.Make('Primitives');
   AddController(
    AddReadonlyListOperations(
     DisableActionElementEvent
     (
      TmsmListViewController.Make(l_AllWords, aFloatingZone)
     )
     , l_AllWords
    )
   );
   // - список примитивов
   Bind(TmsmListOpener.Make(l_AllWords, aUseCase.MainList));
  end;//false

  if true then
  begin
   if false then
   begin
    l_ListContext := TmsmListViewtInitContext_C;
    l_ListContext.rImageNameProp := 'msm:View:StereotypeImageFileName';
    AddChildView('AllowedElements', aFloatingZone, l_ListContext);
    // - список стереотипов доступных для текущего элемента
   end;//false
   if false{true} then
   begin
    l_ListContext := TmsmListViewtInitContext_C;
    AddChildView('AccessibleTypes', aFloatingZone, l_ListContext);
    // - список типов, которые может использовать текущий элемент
   end;//true
   if true then
   begin
    l_ListContext := TmsmListViewtInitContext_C;
    AddChildView('CanImplement', aFloatingZone, l_ListContext);
    // - список методов, которые может реализовывать текущий элемент
   end;//true
   if true then
   begin
    l_ListContext := TmsmListViewtInitContext_C;
    AddChildView('CanOverride', aFloatingZone, l_ListContext);
    // - список методов, которые может перекрывать текущий элемент
   end;//true 
  end;//true
 end;//aFloatingZone <> nil

 if (aTopZone <> nil) then
 begin
  AddController(TmsmButtonEditViewController.Make(aUseCase.ElementToFind, aTopZone));
 end;//aTopZone <> nil
//#UC END# *57D2DFA70064_57D2DF7E00CE_impl*
end;//TmsmDrawingUseCaseView.Create

class function TmsmDrawingUseCaseView.Make(const aUseCase: ImsmDrawingUseCase;
 const aMainZone: ImsmViewParent;
 const aChildZone: ImsmViewParent;
 const aLeftZone: ImsmViewParent;
 const aFloatingZone: ImsmViewParent;
 const aTopZone: ImsmViewParent): ImsmDrawingUseCaseView;
var
 l_Inst : TmsmDrawingUseCaseView;
begin
 l_Inst := Create(aUseCase, aMainZone, aChildZone, aLeftZone, aFloatingZone, aTopZone);
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;//TmsmDrawingUseCaseView.Make

procedure TmsmDrawingUseCaseView.Cleanup;
 {* Функция очистки полей объекта. }
//#UC START# *479731C50290_57D2DF7E00CE_var*
//#UC END# *479731C50290_57D2DF7E00CE_var*
begin
//#UC START# *479731C50290_57D2DF7E00CE_impl*
 inherited;
//#UC END# *479731C50290_57D2DF7E00CE_impl*
end;//TmsmDrawingUseCaseView.Cleanup

procedure TmsmDrawingUseCaseView.DoActivate;
//#UC START# *57D2B82102BD_57D2DF7E00CE_var*
//#UC END# *57D2B82102BD_57D2DF7E00CE_var*
begin
//#UC START# *57D2B82102BD_57D2DF7E00CE_impl*
 inherited;
//#UC END# *57D2B82102BD_57D2DF7E00CE_impl*
end;//TmsmDrawingUseCaseView.DoActivate

procedure TmsmDrawingUseCaseView.DoActivated;
//#UC START# *57DAB38900EF_57D2DF7E00CE_var*
//#UC END# *57DAB38900EF_57D2DF7E00CE_var*
begin
//#UC START# *57DAB38900EF_57D2DF7E00CE_impl*
 inherited;
//#UC END# *57DAB38900EF_57D2DF7E00CE_impl*
end;//TmsmDrawingUseCaseView.DoActivated

//#UC START# *57D2DF7E00CEimpl*
//#UC END# *57D2DF7E00CEimpl*

end.

#1305. MVC. TmsmDrawingUseCase. Только код

unit msmDrawingUseCase;

// Модуль: "w:\common\components\gui\Garant\msm\msmDrawingUseCase.pas"
// Стереотип: "SimpleClass"
// Элемент модели: "TmsmDrawingUseCase" MUID: (57D2A86F0082)

{$Include w:\common\components\gui\Garant\msm\msm.inc}

interface

uses
 l3IntfUses
 , msmUseCase
 , msmConcreteUseCases
 , msmConcreteModels
 , msmControllers
 , msmElementViews
;

type
 TmsmDrawingUseCase = class(TmsmUseCase, ImsmDrawingUseCase)
  private
   f_FloatingNavigator: ImsmTreeModel;
   f_MainList: ImsmListModel;
   f_Drawing: ImsmDrawingModel;
   f_Navigator: ImsmTreeModel;
   f_Caption: ImsmCaptionModel;
   f_FoundElements: ImsmListModel;
   f_ElementToFind: ImsmCaptionModel;
  protected
   function Get_MainList: ImsmListModel;
   function Get_Navigator: ImsmTreeModel;
   function Get_Drawing: ImsmDrawingModel;
   function Get_FloatingNavigator: ImsmTreeModel;
   function Get_Caption: ImsmCaptionModel;
   function Get_FoundElements: ImsmListModel;
   function Get_ElementToFind: ImsmCaptionModel;
   procedure Cleanup; override;
    {* Функция очистки полей объекта. }
   procedure DoActivate; override;
   procedure DoActivated; override;
   procedure ClearFields; override;
  public
   constructor Create(const aViewForTree: TmsmModelElementView;
    const aViewForList: TmsmModelElementView;
    const aCaptionModel: ImsmCaptionModel); reintroduce;
   class function Make(const aViewForTree: TmsmModelElementView;
    const aViewForList: TmsmModelElementView;
    const aCaptionModel: ImsmCaptionModel): ImsmDrawingUseCase; reintroduce;
  public
   property FloatingNavigator: ImsmTreeModel
    read f_FloatingNavigator;
   property MainList: ImsmListModel
    read f_MainList;
   property Drawing: ImsmDrawingModel
    read f_Drawing;
   property Navigator: ImsmTreeModel
    read f_Navigator;
   property Caption: ImsmCaptionModel
    read f_Caption;
   property FoundElements: ImsmListModel
    read f_FoundElements;
   property ElementToFind: ImsmCaptionModel
    read f_ElementToFind;
 end;//TmsmDrawingUseCase

implementation

uses
 l3ImplUses
 , msmTreeModel
 , msmDrawingModel
 , msmListModel
 , msmCaptionModel
 , msmListOwnerNameToCaptionBinding
 , msmListOpener
 , msmListOwnerShowAsListBinding
 , msmCurrentElementSynchronizeBinding
 , msmCurrentElementShowAsListBinding
 , msmListOwnerToCurrentElementBinding
 , msmSomeModelElementsListModel
 , msmWordsManaging
 , msmSomeModelElementsList
 , msmFindWordBinding
 , msmFindWordsBinding
 //#UC START# *57D2A86F0082impl_uses*
 //#UC END# *57D2A86F0082impl_uses*
;

constructor TmsmDrawingUseCase.Create(const aViewForTree: TmsmModelElementView;
 const aViewForList: TmsmModelElementView;
 const aCaptionModel: ImsmCaptionModel);
//#UC START# *57D2A8F301D0_57D2A86F0082_var*
//#UC END# *57D2A8F301D0_57D2A86F0082_var*
begin
//#UC START# *57D2A8F301D0_57D2A86F0082_impl*
 inherited Create;
 f_Navigator := TmsmTreeModel.Make(aViewForTree);
 f_FloatingNavigator := TmsmTreeModel.Make(aViewForTree);
 f_MainList := TmsmListModel.MakeDir(aViewForList);
 if (aCaptionModel = nil) then
  f_Caption := TmsmCaptionModel.Make
 else
  f_Caption := aCaptionModel; 
 f_ElementToFind := TmsmCaptionModel.Make;
 f_Drawing := TmsmDrawingModel.Make(aViewForList.rElement);
 f_FoundElements := TmsmSomeModelElementsListModel.Make(nil, 'Found');

 Bind(TmsmListOwnerNameToCaptionBinding.Make(MainList, Caption));
 // - показываем имя владельца списка в заголовке (формы)

 Bind(TmsmListOpener.Make(MainList, MainList));
 // - открываем новый список MainList -> MainList по ActionElement
 Bind(TmsmListOpener.Make(Drawing, MainList));
 // - открываем новый список Drawing -> MainList по ActionElement
 Bind(TmsmListOpener.Make(FoundElements, MainList));
 // - открываем новый список FoundElements -> MainList по ActionElement
 Bind(TmsmListOpener.Make(Navigator, MainList));
 // - открываем новый список Navigator -> MainList по ActionElement
 Bind(TmsmListOpener.Make(FloatingNavigator, MainList));
 // - открываем новый список FloatingNavigator -> MainList по ActionElement

 Bind(TmsmListOwnerShowAsListBinding.Make(MainList, Drawing));
 Bind(TmsmListOwnerShowAsListBinding.Make(Drawing, MainList));
 // - синхронизируем списки у MainList и Drawing в обе стороны

 Bind(TmsmCurrentElementSynchronizeBinding.Make(MainList, Drawing));
 Bind(TmsmCurrentElementSynchronizeBinding.Make(Drawing, MainList));
 // - синхронизируем текущий элемент у MainList и Drawing в обе стороны

 Bind(TmsmCurrentElementShowAsListBinding.Make(Navigator, MainList));
 // - синхронизируем текущий элемент из Navigator со списком MainList
 Bind(TmsmListOwnerToCurrentElementBinding.Make(MainList, Navigator));
 // - синхронизируем текущий список из MainList с текущим элементом в Navigator

 Bind(TmsmFindWordBinding.Make(ElementToFind, FloatingNavigator));
 Bind(TmsmFindWordsBinding.Make(ElementToFind, FoundElements));
//#UC END# *57D2A8F301D0_57D2A86F0082_impl*
end;//TmsmDrawingUseCase.Create

class function TmsmDrawingUseCase.Make(const aViewForTree: TmsmModelElementView;
 const aViewForList: TmsmModelElementView;
 const aCaptionModel: ImsmCaptionModel): ImsmDrawingUseCase;
var
 l_Inst : TmsmDrawingUseCase;
begin
 l_Inst := Create(aViewForTree, aViewForList, aCaptionModel);
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;//TmsmDrawingUseCase.Make

function TmsmDrawingUseCase.Get_MainList: ImsmListModel;
//#UC START# *57D2D7C0039B_57D2A86F0082get_var*
//#UC END# *57D2D7C0039B_57D2A86F0082get_var*
begin
//#UC START# *57D2D7C0039B_57D2A86F0082get_impl*
 Result := Self.MainList;
//#UC END# *57D2D7C0039B_57D2A86F0082get_impl*
end;//TmsmDrawingUseCase.Get_MainList

function TmsmDrawingUseCase.Get_Navigator: ImsmTreeModel;
//#UC START# *57D2D7D00023_57D2A86F0082get_var*
//#UC END# *57D2D7D00023_57D2A86F0082get_var*
begin
//#UC START# *57D2D7D00023_57D2A86F0082get_impl*
 Result := Self.Navigator;
//#UC END# *57D2D7D00023_57D2A86F0082get_impl*
end;//TmsmDrawingUseCase.Get_Navigator

function TmsmDrawingUseCase.Get_Drawing: ImsmDrawingModel;
//#UC START# *57D2D7DB0283_57D2A86F0082get_var*
//#UC END# *57D2D7DB0283_57D2A86F0082get_var*
begin
//#UC START# *57D2D7DB0283_57D2A86F0082get_impl*
 Result := Self.Drawing;
//#UC END# *57D2D7DB0283_57D2A86F0082get_impl*
end;//TmsmDrawingUseCase.Get_Drawing

function TmsmDrawingUseCase.Get_FloatingNavigator: ImsmTreeModel;
//#UC START# *57D2D7E900D8_57D2A86F0082get_var*
//#UC END# *57D2D7E900D8_57D2A86F0082get_var*
begin
//#UC START# *57D2D7E900D8_57D2A86F0082get_impl*
 Result := Self.FloatingNavigator;
//#UC END# *57D2D7E900D8_57D2A86F0082get_impl*
end;//TmsmDrawingUseCase.Get_FloatingNavigator

function TmsmDrawingUseCase.Get_Caption: ImsmCaptionModel;
//#UC START# *57D2D7F40131_57D2A86F0082get_var*
//#UC END# *57D2D7F40131_57D2A86F0082get_var*
begin
//#UC START# *57D2D7F40131_57D2A86F0082get_impl*
 Result := Self.Caption;
//#UC END# *57D2D7F40131_57D2A86F0082get_impl*
end;//TmsmDrawingUseCase.Get_Caption

function TmsmDrawingUseCase.Get_FoundElements: ImsmListModel;
//#UC START# *57EA784B020D_57D2A86F0082get_var*
//#UC END# *57EA784B020D_57D2A86F0082get_var*
begin
//#UC START# *57EA784B020D_57D2A86F0082get_impl*
 Result := Self.FoundElements;
//#UC END# *57EA784B020D_57D2A86F0082get_impl*
end;//TmsmDrawingUseCase.Get_FoundElements

function TmsmDrawingUseCase.Get_ElementToFind: ImsmCaptionModel;
//#UC START# *57EA811D026D_57D2A86F0082get_var*
//#UC END# *57EA811D026D_57D2A86F0082get_var*
begin
//#UC START# *57EA811D026D_57D2A86F0082get_impl*
 Result := Self.ElementToFind;
//#UC END# *57EA811D026D_57D2A86F0082get_impl*
end;//TmsmDrawingUseCase.Get_ElementToFind

procedure TmsmDrawingUseCase.Cleanup;
 {* Функция очистки полей объекта. }
//#UC START# *479731C50290_57D2A86F0082_var*
//#UC END# *479731C50290_57D2A86F0082_var*
begin
//#UC START# *479731C50290_57D2A86F0082_impl*
 f_FloatingNavigator := nil;
 f_MainList := nil;
 f_Drawing := nil;
 f_Navigator := nil;
 f_Caption := nil;
 inherited;
//#UC END# *479731C50290_57D2A86F0082_impl*
end;//TmsmDrawingUseCase.Cleanup

procedure TmsmDrawingUseCase.DoActivate;
//#UC START# *57D2B82102BD_57D2A86F0082_var*
//#UC END# *57D2B82102BD_57D2A86F0082_var*
begin
//#UC START# *57D2B82102BD_57D2A86F0082_impl*
 inherited;
 //Assert(MainList.List <> nil);
 //Navigator.CurrentElement := MainList.List.Owner;
 //FloatingNavigator.CurrentElement := MainList.List.Owner;
//#UC END# *57D2B82102BD_57D2A86F0082_impl*
end;//TmsmDrawingUseCase.DoActivate

procedure TmsmDrawingUseCase.DoActivated;
//#UC START# *57DAB38900EF_57D2A86F0082_var*
//#UC END# *57DAB38900EF_57D2A86F0082_var*
begin
//#UC START# *57DAB38900EF_57D2A86F0082_impl*
 inherited;
 Assert(MainList.List <> nil);
 Navigator.CurrentElement := MainList.List.Owner;
 FloatingNavigator.CurrentElement := MainList.List.Owner;
//#UC END# *57DAB38900EF_57D2A86F0082_impl*
end;//TmsmDrawingUseCase.DoActivated

procedure TmsmDrawingUseCase.ClearFields;
begin
 f_FloatingNavigator := nil;
 f_MainList := nil;
 f_Drawing := nil;
 f_Navigator := nil;
 f_Caption := nil;
 f_FoundElements := nil;
 f_ElementToFind := nil;
 inherited;
end;//TmsmDrawingUseCase.ClearFields

end.


#1304. MVC. TmsmListLikeModel. Только код

unit msmListLikeModel;

// Модуль: "w:\common\components\gui\Garant\msm\msmListLikeModel.pas"
// Стереотип: "SimpleClass"
// Элемент модели: "TmsmListLikeModel" MUID: (57B57EDB003F)

{$Include w:\common\components\gui\Garant\msm\msm.inc}

interface

uses
 l3IntfUses
 , msmModel
 , msmConcreteModels
 , msmElementViews
 , msmModelElements
 , l3Interfaces
 {$If NOT Defined(NoScripts)}
 , tfwScriptingInterfaces
 {$IfEnd} // NOT Defined(NoScripts)
 , msmDefaultModels
;

type
 TmsmListLikeModel = {abstract} class(TmsmModel, ImsmListLikeModel, ImsmCaptionModel, ImsmDragAndDropModel)
  private
   f_Selection: ImsmElementSelection;
   f_ElementToAction: ImsmModelElement;
  protected
   f_ElementView: TmsmModelElementView;
  protected
   function DoGetList: ImsmModelElementStringList; virtual; abstract;
   procedure DoShowElementAsList(const anElement: ImsmModelElement); virtual; abstract;
   function DoGetCaption: AnsiString; virtual;
   function As_ImsmDragAndDropModel: ImsmDragAndDropModel;
    {* Метод приведения нашего интерфейса к ImsmDragAndDropModel }
   procedure ShowElementAsList(const anElement: ImsmModelElement);
   function Get_Caption: Il3CString;
   procedure Set_Caption(const aValue: Il3CString);
   function Get_ElementToAction: ImsmModelElement;
   procedure Set_ElementToAction(const aValue: ImsmModelElement);
   function Get_CurrentElement: ImsmModelElement;
   procedure Set_CurrentElement(const aValue: ImsmModelElement);
   function Get_List: ImsmModelElementStringList;
   function Get_Selection: ImsmElementSelection;
   procedure Paste(const aSelection: ImsmElementSelection); overload;
   procedure Paste(const aDataObject: IDataObject); overload;
   procedure Paste; overload;
   procedure Paste(const anArray: ItfwArray); overload;
   function Drop(const anElement: ImsmModelElement;
    const aPoint: Tl3SPoint): Boolean; overload;
   function CanPaste(const aSelection: ImsmElementSelection): Boolean;
   function CanAddNewElement: Boolean;
   procedure AddNewElement(const anElementName: AnsiString;
    const anElementStereotype: ImsmModelElement;
    const aKeyValues: ItfwArray);
   procedure DeleteSelection;
   function CanDeleteSelection: Boolean;
   procedure ChangeProperties(const aKeyValues: ItfwArray);
   function CanChangeProperties: Boolean;
   function PropertiesForNewElement: ItfwArray;
   function Properties: ItfwArray;
   procedure InitFields; override;
   procedure ClearFields; override;
  public
   constructor Create(const anElementView: TmsmModelElementView); reintroduce;
   function Drop(aFormat: Tl3ClipboardFormat;
    const aMedium: Tl3StoragePlace;
    var dwEffect: Integer;
    const aPoint: Tl3SPoint): Boolean; overload;
   function DragOver(const aData: IDataObject;
    const aPoint: TPoint): Boolean;
  public
   property Selection: ImsmElementSelection
    read f_Selection;
 end;//TmsmListLikeModel

implementation

uses
 l3ImplUses
 , l3CProtoObject
 , msmModelElementSelectService
 , msmListAndTreeInterfaces
 , msmElementSelection
 , tfwCStringFactory
 , msmModelElementMethodCaller
 {$If NOT Defined(NoScripts)}
 , tfwWordsIterator
 {$IfEnd} // NOT Defined(NoScripts)
 {$If NOT Defined(NoScripts)}
 , tfwWordRefList
 {$IfEnd} // NOT Defined(NoScripts)
 , SysUtils
 , l3SysUtils
 , l3Base
 //#UC START# *57B57EDB003Fimpl_uses*
 , Windows
 , l3TreeConst
 , l3TreeInterfaces
 , msmModelElementNode
 , msmModelElement
 , l3String
 , msmDeletedElements
 , msmChangedElements
 , msmWaitCursor
 //#UC END# *57B57EDB003Fimpl_uses*
;

type
 TmsmListLikeModelWorker = class(Tl3CProtoObject)
  private
   f_Model: ImsmListLikeModel;
   f_Target: ImsmModelElement;
  protected
   procedure ClearFields; override;
  public
   constructor Create(const aModel: ImsmListLikeModel;
    const aTarget: ImsmModelElement); reintroduce;
  protected
   property Model: ImsmListLikeModel
    read f_Model;
   property Target: ImsmModelElement
    read f_Target;
 end;//TmsmListLikeModelWorker

 TmsmAttributeAdder = class(TmsmListLikeModelWorker, ImsmElementSelector)
  protected
   procedure SelectElement(const anElementName: AnsiString;
    const anElementStereotype: ImsmModelElement;
    const aKeyValues: ItfwArray);
   function SelectFormCaption: AnsiString;
   function KeyValues: ItfwArray;
  public
   class function Make(const aModel: ImsmListLikeModel;
    const aTarget: ImsmModelElement): ImsmElementSelector; reintroduce;
 end;//TmsmAttributeAdder

 TmsmOperationAdder = class(TmsmListLikeModelWorker, ImsmElementSelector)
  protected
   procedure SelectElement(const anElementName: AnsiString;
    const anElementStereotype: ImsmModelElement;
    const aKeyValues: ItfwArray);
   function SelectFormCaption: AnsiString;
   function KeyValues: ItfwArray;
  public
   class function Make(const aModel: ImsmListLikeModel;
    const aTarget: ImsmModelElement): ImsmElementSelector; reintroduce;
 end;//TmsmOperationAdder

 TmsmDependencyAdder = class(TmsmListLikeModelWorker, ImsmElementSelector)
  protected
   procedure SelectElement(const anElementName: AnsiString;
    const anElementStereotype: ImsmModelElement;
    const aKeyValues: ItfwArray);
   function SelectFormCaption: AnsiString;
   function KeyValues: ItfwArray;
  public
   class function Make(const aModel: ImsmListLikeModel;
    const aTarget: ImsmModelElement): ImsmElementSelector; reintroduce;
 end;//TmsmDependencyAdder

 TmsmParameterAdder = class(TmsmListLikeModelWorker, ImsmElementSelector)
  protected
   procedure SelectElement(const anElementName: AnsiString;
    const anElementStereotype: ImsmModelElement;
    const aKeyValues: ItfwArray);
   function SelectFormCaption: AnsiString;
   function KeyValues: ItfwArray;
  public
   class function Make(const aModel: ImsmListLikeModel;
    const aTarget: ImsmModelElement): ImsmElementSelector; reintroduce;
 end;//TmsmParameterAdder

constructor TmsmListLikeModelWorker.Create(const aModel: ImsmListLikeModel;
 const aTarget: ImsmModelElement);
//#UC START# *58049B0200B1_58049A4D0355_var*
//#UC END# *58049B0200B1_58049A4D0355_var*
begin
//#UC START# *58049B0200B1_58049A4D0355_impl*
 Assert(aModel <> nil);
 Assert(aTarget <> nil);
 f_Model := aModel;
 f_Target := aTarget;
 inherited Create;
//#UC END# *58049B0200B1_58049A4D0355_impl*
end;//TmsmListLikeModelWorker.Create

procedure TmsmListLikeModelWorker.ClearFields;
begin
 f_Model := nil;
 f_Target := nil;
 inherited;
end;//TmsmListLikeModelWorker.ClearFields

class function TmsmAttributeAdder.Make(const aModel: ImsmListLikeModel;
 const aTarget: ImsmModelElement): ImsmElementSelector;
var
 l_Inst : TmsmAttributeAdder;
begin
 l_Inst := Create(aModel, aTarget);
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;//TmsmAttributeAdder.Make

procedure TmsmAttributeAdder.SelectElement(const anElementName: AnsiString;
 const anElementStereotype: ImsmModelElement;
 const aKeyValues: ItfwArray);
//#UC START# *57F509AC007F_58049B2C00EB_var*
//#UC END# *57F509AC007F_58049B2C00EB_var*
begin
//#UC START# *57F509AC007F_58049B2C00EB_impl*
 Model.AddNewElement(anElementName, anElementStereotype, aKeyValues);
//#UC END# *57F509AC007F_58049B2C00EB_impl*
end;//TmsmAttributeAdder.SelectElement

function TmsmAttributeAdder.SelectFormCaption: AnsiString;
//#UC START# *57FB8665023E_58049B2C00EB_var*
//#UC END# *57FB8665023E_58049B2C00EB_var*
begin
//#UC START# *57FB8665023E_58049B2C00EB_impl*
 Result := 'Add attribute';
//#UC END# *57FB8665023E_58049B2C00EB_impl*
end;//TmsmAttributeAdder.SelectFormCaption

function TmsmAttributeAdder.KeyValues: ItfwArray;
//#UC START# *57FB86B0027E_58049B2C00EB_var*
//#UC END# *57FB86B0027E_58049B2C00EB_var*
begin
//#UC START# *57FB86B0027E_58049B2C00EB_impl*
 TmsmWaitCursor.Make;
 Result := Model.List.Owner.CallAndGetList([TtfwStackValue_C(Self.Target.MainWord)], 'msm:KeyValuesForNewAttribute');
//#UC END# *57FB86B0027E_58049B2C00EB_impl*
end;//TmsmAttributeAdder.KeyValues

class function TmsmOperationAdder.Make(const aModel: ImsmListLikeModel;
 const aTarget: ImsmModelElement): ImsmElementSelector;
var
 l_Inst : TmsmOperationAdder;
begin
 l_Inst := Create(aModel, aTarget);
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;//TmsmOperationAdder.Make

procedure TmsmOperationAdder.SelectElement(const anElementName: AnsiString;
 const anElementStereotype: ImsmModelElement;
 const aKeyValues: ItfwArray);
//#UC START# *57F509AC007F_58049DA603A3_var*
//#UC END# *57F509AC007F_58049DA603A3_var*
begin
//#UC START# *57F509AC007F_58049DA603A3_impl*
 Model.AddNewElement(anElementName, anElementStereotype, aKeyValues);
//#UC END# *57F509AC007F_58049DA603A3_impl*
end;//TmsmOperationAdder.SelectElement

function TmsmOperationAdder.SelectFormCaption: AnsiString;
//#UC START# *57FB8665023E_58049DA603A3_var*
//#UC END# *57FB8665023E_58049DA603A3_var*
begin
//#UC START# *57FB8665023E_58049DA603A3_impl*
 Result := 'Add operation';
//#UC END# *57FB8665023E_58049DA603A3_impl*
end;//TmsmOperationAdder.SelectFormCaption

function TmsmOperationAdder.KeyValues: ItfwArray;
//#UC START# *57FB86B0027E_58049DA603A3_var*
//#UC END# *57FB86B0027E_58049DA603A3_var*
begin
//#UC START# *57FB86B0027E_58049DA603A3_impl*
 TmsmWaitCursor.Make;
 Result := Model.List.Owner.CallAndGetList([TtfwStackValue_C(Self.Target.MainWord)], 'msm:KeyValuesForNewOperation');
//#UC END# *57FB86B0027E_58049DA603A3_impl*
end;//TmsmOperationAdder.KeyValues

class function TmsmDependencyAdder.Make(const aModel: ImsmListLikeModel;
 const aTarget: ImsmModelElement): ImsmElementSelector;
var
 l_Inst : TmsmDependencyAdder;
begin
 l_Inst := Create(aModel, aTarget);
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;//TmsmDependencyAdder.Make

procedure TmsmDependencyAdder.SelectElement(const anElementName: AnsiString;
 const anElementStereotype: ImsmModelElement;
 const aKeyValues: ItfwArray);
//#UC START# *57F509AC007F_5804A3BE00EE_var*
//#UC END# *57F509AC007F_5804A3BE00EE_var*
begin
//#UC START# *57F509AC007F_5804A3BE00EE_impl*
 Model.AddNewElement(anElementName, anElementStereotype, aKeyValues);
//#UC END# *57F509AC007F_5804A3BE00EE_impl*
end;//TmsmDependencyAdder.SelectElement

function TmsmDependencyAdder.SelectFormCaption: AnsiString;
//#UC START# *57FB8665023E_5804A3BE00EE_var*
//#UC END# *57FB8665023E_5804A3BE00EE_var*
begin
//#UC START# *57FB8665023E_5804A3BE00EE_impl*
 Result := 'Add dependency';
//#UC END# *57FB8665023E_5804A3BE00EE_impl*
end;//TmsmDependencyAdder.SelectFormCaption

function TmsmDependencyAdder.KeyValues: ItfwArray;
//#UC START# *57FB86B0027E_5804A3BE00EE_var*
//#UC END# *57FB86B0027E_5804A3BE00EE_var*
begin
//#UC START# *57FB86B0027E_5804A3BE00EE_impl*
 TmsmWaitCursor.Make;
 Result := Model.List.Owner.CallAndGetList([TtfwStackValue_C(Self.Target.MainWord)], 'msm:KeyValuesForNewDependency');
//#UC END# *57FB86B0027E_5804A3BE00EE_impl*
end;//TmsmDependencyAdder.KeyValues

class function TmsmParameterAdder.Make(const aModel: ImsmListLikeModel;
 const aTarget: ImsmModelElement): ImsmElementSelector;
var
 l_Inst : TmsmParameterAdder;
begin
 l_Inst := Create(aModel, aTarget);
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;//TmsmParameterAdder.Make

procedure TmsmParameterAdder.SelectElement(const anElementName: AnsiString;
 const anElementStereotype: ImsmModelElement;
 const aKeyValues: ItfwArray);
//#UC START# *57F509AC007F_5810ACC40099_var*
//#UC END# *57F509AC007F_5810ACC40099_var*
begin
//#UC START# *57F509AC007F_5810ACC40099_impl*
 Model.AddNewElement(anElementName, anElementStereotype, aKeyValues);
//#UC END# *57F509AC007F_5810ACC40099_impl*
end;//TmsmParameterAdder.SelectElement

function TmsmParameterAdder.SelectFormCaption: AnsiString;
//#UC START# *57FB8665023E_5810ACC40099_var*
//#UC END# *57FB8665023E_5810ACC40099_var*
begin
//#UC START# *57FB8665023E_5810ACC40099_impl*
 Result := 'Add parameter';
//#UC END# *57FB8665023E_5810ACC40099_impl*
end;//TmsmParameterAdder.SelectFormCaption

function TmsmParameterAdder.KeyValues: ItfwArray;
//#UC START# *57FB86B0027E_5810ACC40099_var*
//#UC END# *57FB86B0027E_5810ACC40099_var*
begin
//#UC START# *57FB86B0027E_5810ACC40099_impl*
 TmsmWaitCursor.Make;
 Result := Model.List.Owner.CallAndGetList([TtfwStackValue_C(Self.Target.MainWord)], 'msm:KeyValuesForNewParameter');
//#UC END# *57FB86B0027E_5810ACC40099_impl*
end;//TmsmParameterAdder.KeyValues

function TmsmListLikeModel.DoGetCaption: AnsiString;
//#UC START# *57E331B90378_57B57EDB003F_var*
//#UC END# *57E331B90378_57B57EDB003F_var*
begin
//#UC START# *57E331B90378_57B57EDB003F_impl*
 Result := f_ElementView.rListName;
 if (Result = 'SelfList') then
  Result := f_ElementView.rTextName;
 if (Result = 'DocumentationNotEmpty') then
  Result := 'Doc';
//#UC END# *57E331B90378_57B57EDB003F_impl*
end;//TmsmListLikeModel.DoGetCaption

constructor TmsmListLikeModel.Create(const anElementView: TmsmModelElementView);
//#UC START# *57E410A500DD_57B57EDB003F_var*
//#UC END# *57E410A500DD_57B57EDB003F_var*
begin
//#UC START# *57E410A500DD_57B57EDB003F_impl*
 f_ElementView := anElementView;
 inherited Create;
//#UC END# *57E410A500DD_57B57EDB003F_impl*
end;//TmsmListLikeModel.Create

function TmsmListLikeModel.As_ImsmDragAndDropModel: ImsmDragAndDropModel;
 {* Метод приведения нашего интерфейса к ImsmDragAndDropModel }
begin
 Result := Self;
end;//TmsmListLikeModel.As_ImsmDragAndDropModel

procedure TmsmListLikeModel.ShowElementAsList(const anElement: ImsmModelElement);
//#UC START# *57B1A3DA0382_57B57EDB003F_var*
//#UC END# *57B1A3DA0382_57B57EDB003F_var*
begin
//#UC START# *57B1A3DA0382_57B57EDB003F_impl*
 DoShowElementAsList(anElement);
//#UC END# *57B1A3DA0382_57B57EDB003F_impl*
end;//TmsmListLikeModel.ShowElementAsList

function TmsmListLikeModel.Get_Caption: Il3CString;
//#UC START# *57B1A47403C5_57B57EDB003Fget_var*
//#UC END# *57B1A47403C5_57B57EDB003Fget_var*
begin
//#UC START# *57B1A47403C5_57B57EDB003Fget_impl*
 Result := TtfwCStringFactory.C(DoGetCaption); 
//#UC END# *57B1A47403C5_57B57EDB003Fget_impl*
end;//TmsmListLikeModel.Get_Caption

procedure TmsmListLikeModel.Set_Caption(const aValue: Il3CString);
//#UC START# *57B1A47403C5_57B57EDB003Fset_var*
//#UC END# *57B1A47403C5_57B57EDB003Fset_var*
begin
//#UC START# *57B1A47403C5_57B57EDB003Fset_impl*
 // - ничего не делаем
//#UC END# *57B1A47403C5_57B57EDB003Fset_impl*
end;//TmsmListLikeModel.Set_Caption

function TmsmListLikeModel.Get_ElementToAction: ImsmModelElement;
//#UC START# *57B2B019009C_57B57EDB003Fget_var*
//#UC END# *57B2B019009C_57B57EDB003Fget_var*
begin
//#UC START# *57B2B019009C_57B57EDB003Fget_impl*
 Result := f_ElementToAction;
//#UC END# *57B2B019009C_57B57EDB003Fget_impl*
end;//TmsmListLikeModel.Get_ElementToAction

procedure TmsmListLikeModel.Set_ElementToAction(const aValue: ImsmModelElement);
//#UC START# *57B2B019009C_57B57EDB003Fset_var*
//#UC END# *57B2B019009C_57B57EDB003Fset_var*
begin
//#UC START# *57B2B019009C_57B57EDB003Fset_impl*
 f_ElementToAction := aValue;
 Fire(ActionElementEvent.Instance);
//#UC END# *57B2B019009C_57B57EDB003Fset_impl*
end;//TmsmListLikeModel.Set_ElementToAction

function TmsmListLikeModel.Get_CurrentElement: ImsmModelElement;
//#UC START# *57B31CF301D2_57B57EDB003Fget_var*
//#UC END# *57B31CF301D2_57B57EDB003Fget_var*
begin
//#UC START# *57B31CF301D2_57B57EDB003Fget_impl*
 Assert(Selection <> nil);
 Result := Selection.CurrentElement;
//#UC END# *57B31CF301D2_57B57EDB003Fget_impl*
end;//TmsmListLikeModel.Get_CurrentElement

procedure TmsmListLikeModel.Set_CurrentElement(const aValue: ImsmModelElement);
//#UC START# *57B31CF301D2_57B57EDB003Fset_var*
//#UC END# *57B31CF301D2_57B57EDB003Fset_var*
begin
//#UC START# *57B31CF301D2_57B57EDB003Fset_impl*
 if (f_Selection = nil) then
  f_Selection := TmsmElementSelection.Make(Self);
 Assert(Selection <> nil);
 Selection.CurrentElement := aValue;
//#UC END# *57B31CF301D2_57B57EDB003Fset_impl*
end;//TmsmListLikeModel.Set_CurrentElement

function TmsmListLikeModel.Get_List: ImsmModelElementStringList;
//#UC START# *57B6A4550271_57B57EDB003Fget_var*
//#UC END# *57B6A4550271_57B57EDB003Fget_var*
begin
//#UC START# *57B6A4550271_57B57EDB003Fget_impl*
 Result := DoGetList;
//#UC END# *57B6A4550271_57B57EDB003Fget_impl*
end;//TmsmListLikeModel.Get_List

function TmsmListLikeModel.Get_Selection: ImsmElementSelection;
//#UC START# *57D8F1B70265_57B57EDB003Fget_var*
//#UC END# *57D8F1B70265_57B57EDB003Fget_var*
begin
//#UC START# *57D8F1B70265_57B57EDB003Fget_impl*
 Result := Selection;
//#UC END# *57D8F1B70265_57B57EDB003Fget_impl*
end;//TmsmListLikeModel.Get_Selection

procedure TmsmListLikeModel.Paste(const aSelection: ImsmElementSelection);
//#UC START# *57E283A603D2_57B57EDB003F_var*
//#UC END# *57E283A603D2_57B57EDB003F_var*
begin
//#UC START# *57E283A603D2_57B57EDB003F_impl*
 Assert(aSelection <> nil);
 Paste(aSelection.AsArray);
//#UC END# *57E283A603D2_57B57EDB003F_impl*
end;//TmsmListLikeModel.Paste

procedure TmsmListLikeModel.Paste(const aDataObject: IDataObject);
//#UC START# *57E3F713019E_57B57EDB003F_var*
var
 l_Sel : ImsmElementSelection;
//#UC END# *57E3F713019E_57B57EDB003F_var*
begin
//#UC START# *57E3F713019E_57B57EDB003F_impl*
 if Supports(aDataObject, ImsmElementSelection, l_Sel) then
  try
   Self.Paste(l_Sel);
  finally
   l_Sel := nil;
  end;//try..finally
//#UC END# *57E3F713019E_57B57EDB003F_impl*
end;//TmsmListLikeModel.Paste

procedure TmsmListLikeModel.Paste;
//#UC START# *57E3F7330377_57B57EDB003F_var*
var
 l_IData : IDataObject;
//#UC END# *57E3F7330377_57B57EDB003F_var*
begin
//#UC START# *57E3F7330377_57B57EDB003F_impl*
 if not l3IFail(OleGetClipboard(l_IData)) then
  try
   Self.Paste(l_IData);
  finally
   l_IData := nil;
  end;//try..finally
//#UC END# *57E3F7330377_57B57EDB003F_impl*
end;//TmsmListLikeModel.Paste

procedure TmsmListLikeModel.Paste(const anArray: ItfwArray);
//#UC START# *57E3FC26029F_57B57EDB003F_var*
var
 l_A : ItfwArray;
//#UC END# *57E3FC26029F_57B57EDB003F_var*
begin
//#UC START# *57E3FC26029F_57B57EDB003F_impl*
 Assert(Self.Get_List <> nil);
 Assert(Self.Get_List.Owner <> nil);
 if Self.Get_List.Owner.BoolProp['IsDiagram'] then
  l_A := Self.Get_List.Owner.CallAndGetList([TtfwStackValue_C(anArray)], 'msm:Diagram:PasteElements')
 else
  Assert(false);
 //Fire(ListContentChangedEvent.Instance);
 Selection.SelectElements(l_A); 
//#UC END# *57E3FC26029F_57B57EDB003F_impl*
end;//TmsmListLikeModel.Paste

function TmsmListLikeModel.Drop(aFormat: Tl3ClipboardFormat;
 const aMedium: Tl3StoragePlace;
 var dwEffect: Integer;
 const aPoint: Tl3SPoint): Boolean;
//#UC START# *57E410D101DC_57B57EDB003F_var*
var
 l_Data: Pl3TreeData;
 l_W : ITmsmModelElementNodeWrap;
//#UC END# *57E410D101DC_57B57EDB003F_var*
begin
//#UC START# *57E410D101DC_57B57EDB003F_impl*
 Result := false;
 if (aFormat = CF_TreeNode) then
 begin
  if (aMedium.tymed = TYMED_HGLOBAL) then
  begin
   l_Data := GlobalLock(aMedium.hGlobal);
   try
    if not l_Data.rMultiSelection AND (l_Data.rNode <> nil) then
    begin
     if Supports(l_Data.rNode, ITmsmModelElementNodeWrap, l_W) then
      try
       Result := Drop(l_W.GetSelf.Element.rElement, aPoint);
      finally
       l_W := nil;
      end;//try..finally
    end;//not l_Data.rMultiSelection AND (l_Data.rNode <> nil)
   finally
    GlobalUnlock(aMedium.hGlobal);
   end;//try..finally
  end;//aMedium.tymed = TYMED_HGLOBAL
 end;//aFormat = CF_TreeNode
//#UC END# *57E410D101DC_57B57EDB003F_impl*
end;//TmsmListLikeModel.Drop

function TmsmListLikeModel.Drop(const anElement: ImsmModelElement;
 const aPoint: Tl3SPoint): Boolean;
//#UC START# *57E4210F0225_57B57EDB003F_var*
var
 l_E : ImsmModelElement;
//#UC END# *57E4210F0225_57B57EDB003F_var*
begin
//#UC START# *57E4210F0225_57B57EDB003F_impl*
 l_E := nil;
 if {(f_ElementView.rListName = 'Inherits')
    OR (f_ElementView.rListName = 'Implements')}
    false
    then
 begin
  Assert(Self.f_ElementView.rElement <> nil);
  Assert(not Self.f_ElementView.rElement.BoolProp['IsSomeView']);
  Self.f_ElementView.rElement.ElementProp['Viewed'].Call(
   [TtfwStackValue_C(anElement.ElementProp['Viewed'].MainWord)],
   'msm:AddToCollection: .' + f_ElementView.rListName
  );
  l_E := anElement;
 end//f_ElementView.rListName = 'Inherits'..
 else
 if (f_ElementView.rListName = 'Overridden')
    OR (f_ElementView.rListName = 'Inherits')
    OR (f_ElementView.rListName = 'Implements')
    then
 begin
  Assert(Self.f_ElementView.rElement <> nil);
  Assert(not Self.f_ElementView.rElement.BoolProp['IsSomeView']);
  l_E :=
   TmsmModelElement.MakeFromValue(
    Self.f_ElementView.rElement.ElementProp['Viewed'].Call(
     [TtfwStackValue_C(anElement.ElementProp['Viewed'].MainWord)],
     'msm:Add' + f_ElementView.rListName
    )
  );
 end//(f_ElementView.rListName = 'Overridden')
 else
 if (f_ElementView.rListName = 'Attributes') then
  TmsmModelElementSelectService.Instance.SelectElement(TmsmAttributeAdder.Make(Self, anElement))
 else
 if (f_ElementView.rListName = 'Operations') then
  TmsmModelElementSelectService.Instance.SelectElement(TmsmOperationAdder.Make(Self, anElement))
 else
 if (f_ElementView.rListName = 'Dependencies') then
  TmsmModelElementSelectService.Instance.SelectElement(TmsmDependencyAdder.Make(Self, anElement))
 else
 if (f_ElementView.rListName = 'Parameters') then
  TmsmModelElementSelectService.Instance.SelectElement(TmsmParameterAdder.Make(Self, anElement))
 else
 begin
  Assert(Self.Get_List <> nil);
  Assert(Self.Get_List.Owner <> nil);
  if Self.Get_List.Owner.BoolProp['IsDiagram'] then
  begin
   l_E :=
    TmsmModelElement.MakeFromValue(
     Self.Get_List.Owner.Call(
      [TtfwStackValue_C(anElement.MainWord),
       TtfwStackValue_C(aPoint.X),
       TtfwStackValue_C(aPoint.Y)],
      'msm:Diagram:PasteElement'
     )
    );
  end//Self.Get_List.Owner.BoolProp['IsDiagram']
  else
   Assert(false);
 end;//else 
 //Fire(ListContentChangedEvent.Instance);
 if (l_E <> nil) then
 begin
  Selection.Clear;
  Selection.CurrentElement := l_E;
 end;//l_E <> nil
 Result := true;
//#UC END# *57E4210F0225_57B57EDB003F_impl*
end;//TmsmListLikeModel.Drop

function TmsmListLikeModel.CanPaste(const aSelection: ImsmElementSelection): Boolean;
//#UC START# *57EB7E79022F_57B57EDB003F_var*
//#UC END# *57EB7E79022F_57B57EDB003F_var*
begin
//#UC START# *57EB7E79022F_57B57EDB003F_impl*
 Result := false;
 if (aSelection = nil) then
  Exit;
 if (Self.Get_List = nil) then
  Exit; 
 if (Self.Get_List.Owner = nil) then
  Exit; 
 if not Self.Get_List.Owner.BoolProp['IsDiagram'] then
  Exit;
 Result := true;
//#UC END# *57EB7E79022F_57B57EDB003F_impl*
end;//TmsmListLikeModel.CanPaste

function TmsmListLikeModel.CanAddNewElement: Boolean;
//#UC START# *57F4FE6D0164_57B57EDB003F_var*
//#UC END# *57F4FE6D0164_57B57EDB003F_var*
begin
//#UC START# *57F4FE6D0164_57B57EDB003F_impl*
 Result := false;
 if (f_ElementView.rListName = 'Attributes')
    OR (f_ElementView.rListName = 'Operations')
    OR (f_ElementView.rListName = 'Dependencies')
    OR (f_ElementView.rListName = 'Parameters')
    then
 begin
  if (f_ElementView.rElement = nil) then
   Exit;
  if (f_ElementView.rElement.MEList['AllowedElements'].Count <= 0) then
   Exit;
  Result := true;
  Exit;
 end;//f_ElementView.rListName = 'Attributes'

 if (f_ElementView.rListName = 'Inherits') then
 begin
  if (f_ElementView.rElement = nil) then
   Exit;
  Result := true;
  Exit;
 end;//f_ElementView.rListName = 'Inherits'

 if (f_ElementView.rListName = 'Overridden') then
 begin
  if (f_ElementView.rElement = nil) then
   Exit;
  Result := true;
  Exit;
 end;//f_ElementView.rListName = 'Overridden'

 if (f_ElementView.rListName = 'Implements') then
 begin
  if (f_ElementView.rElement = nil) then
   Exit;
  Result := true;
  Exit;
 end;//f_ElementView.rListName = 'Implements'

 if (Self.Get_List = nil) then
  Exit; 
 if (Self.Get_List.Owner = nil) then
  Exit; 
 if (Self.Get_List.Owner.MEList['AllowedElements'].Count <= 0) then
  Exit;
 if Self.Get_List.Owner.BoolProp['IsDiagram'] then
 begin
  Result := true;
  Exit;
 end;//Self.Get_List.Owner.BoolProp['IsDiagram']
//#UC END# *57F4FE6D0164_57B57EDB003F_impl*
end;//TmsmListLikeModel.CanAddNewElement

procedure TmsmListLikeModel.AddNewElement(const anElementName: AnsiString;
 const anElementStereotype: ImsmModelElement;
 const aKeyValues: ItfwArray);
//#UC START# *57F4FE8F022B_57B57EDB003F_var*
var
 l_E : ImsmModelElement;
//#UC END# *57F4FE8F022B_57B57EDB003F_var*
begin
//#UC START# *57F4FE8F022B_57B57EDB003F_impl*
 //Assert(anElementName <> '');
 //Assert(anElementStereotype <> nil);
 l_E := nil;
 if (f_ElementView.rListName = 'Attributes')
    OR (f_ElementView.rListName = 'Operations')
    OR (f_ElementView.rListName = 'Dependencies')
    OR (f_ElementView.rListName = 'Parameters') then
 begin
  Assert(anElementStereotype <> nil);
  Assert(not Self.f_ElementView.rElement.BoolProp['IsSomeView']);
  Assert(not Self.f_ElementView.rElement.BoolProp['IsDiagram']);
  l_E :=
   TmsmModelElement.MakeFromValue(
    Self.f_ElementView.rElement.Call(
     [TtfwStackValue_C(TtfwCStringFactory.C(anElementName)),
      TtfwStackValue_C(anElementStereotype.MainWord),
      TtfwStackValue_C(aKeyValues)],
     'msm:AddElement'
    )
   );
 end//f_ElementView.rListName = 'Attributes'
 else
 if (f_ElementView.rListName = 'Inherits') then
 begin
  Assert(not Self.f_ElementView.rElement.BoolProp['IsSomeView']);
  Assert(not Self.f_ElementView.rElement.BoolProp['IsDiagram']);
    Self.f_ElementView.rElement.Call(
     [TtfwStackValue_C(aKeyValues)],
     'msm:AddNewInherits'
    )
 end//f_ElementView.rListName = 'Inherits'
 else
 if (f_ElementView.rListName = 'Implements') then
 begin
  Assert(not Self.f_ElementView.rElement.BoolProp['IsSomeView']);
  Assert(not Self.f_ElementView.rElement.BoolProp['IsDiagram']);
    Self.f_ElementView.rElement.Call(
     [TtfwStackValue_C(aKeyValues)],
     'msm:AddNewImplements'
    )
 end//f_ElementView.rListName = 'Implements'
 else
 if (f_ElementView.rListName = 'Overridden') then
 begin
  Assert(not Self.f_ElementView.rElement.BoolProp['IsSomeView']);
  Assert(not Self.f_ElementView.rElement.BoolProp['IsDiagram']);
    Self.f_ElementView.rElement.Call(
     [TtfwStackValue_C(aKeyValues)],
     'msm:AddNewOverridden'
    )
 end//f_ElementView.rListName = 'Overridden'
 else
 begin
  Assert(anElementStereotype <> nil);
  Assert(Self.Get_List <> nil);
  Assert(Self.Get_List.Owner <> nil);
  if Self.Get_List.Owner.BoolProp['IsDiagram'] then
   l_E :=
    TmsmModelElement.MakeFromValue(
     Self.Get_List.Owner.Call(
      [TtfwStackValue_C(TtfwCStringFactory.C(anElementName)),
       TtfwStackValue_C(anElementStereotype.MainWord),
       TtfwStackValue_C(aKeyValues)],
      'msm:Diagram:AddElement'
     )
    )
  else
   Assert(false);
 end;//else
 //Fire(ListContentChangedEvent.Instance);
 if (l_E <> nil) then
 begin
  Selection.Clear;
  Selection.CurrentElement := l_E;
 end;//l_E <> nil
//#UC END# *57F4FE8F022B_57B57EDB003F_impl*
end;//TmsmListLikeModel.AddNewElement

procedure TmsmListLikeModel.DeleteSelection;
//#UC START# *57F7B78D0250_57B57EDB003F_var*

 procedure DoDeleteView;

  function DoElement(const anElement: ImsmModelElement): Boolean;
  begin//DoElement
   Result := true;
   if not anElement.IsSameElement(Self.Get_List.Owner) then
    if anElement.BoolProp['IsSomeView'] then
    // - тут удалять можно только View
     anElement.Delete;
  end;//DoElement

 begin//DoDeleteView
  Selection.ProcessSelectedF(L2ImsmElementSelectionProcessSelectedFAction(@DoElement));
  Fire(ListContentChangedEvent.Instance);
 end;//DoDeleteView

 procedure DoDeleteElement;

  procedure DeleteElement(const anElement: ImsmModelElement);
  begin//DeleteElement
   if (anElement <> nil) then
   begin
    TmsmDeletedElements.Instance.Add(anElement.MainWord);
    //anElement.Delete;
    // - тут нельзя Delete звать ибо например для Override неправильно работает
    // да и для DecoretedType'ов - тоже
   end;//anElement <> nil
  end;//DeleteElement

  function DoElement(const anElement: ImsmModelElement): Boolean;
  begin//DoElement
   Result := true;
   if not anElement.IsSameElement(Self.Get_List.Owner) then
   // - вообще-то эта проверка - ЛИШНЯЯ,
   //   т.к. у элемента могут быть ссылки на СЕБЯ ЖЕ
   // - и ниже проверка - лишняя
   // ТАК это же - ССЫЛКИ, он НЕ РАВНЫ самому ЭЛЕМЕНТУ,
   // так что - всё правильно, сам элемент у них в поле Target
   begin
    Assert(not anElement.BoolProp['IsSomeView']);
    // - ибо пока по-моему такого не бывает, а там логика может быть более сложная
    // - здесь ещё надо вставить проверку того, что элемент принадлежит списку
    // Иначе можно огрести как с пустым Inherits.
    DeleteElement(anElement);
(*    if anElement.BoolProp['IsSomeView'] then
      DeleteElement(anElement.ElementProp['Viewed']);*)
   end;//not anElement.IsSameElement(Self.Get_List.Owner)
  end;//DoElement

 begin//DoDeleteElement
  Assert(not Self.Get_List.Owner.BoolProp['IsSomeView']);
  // - ибо пока по-моему такого не бывает, а там логика может быть более сложная
  Selection.ProcessSelectedF(L2ImsmElementSelectionProcessSelectedFAction(@DoElement));
  TmsmChangedElements.Instance.Add(Self.Get_List.Owner.MainWord);
  Fire(ListContentChangedEvent.Instance);
 end;//DoDeleteElement

//#UC END# *57F7B78D0250_57B57EDB003F_var*
begin
//#UC START# *57F7B78D0250_57B57EDB003F_impl*
 Assert(Selection <> nil);
 Assert(Self.Get_List.Owner <> nil);
 if Self.Get_List.Owner.BoolProp['IsDiagram'] then
  DoDeleteView
 else
 if (f_ElementView.rListName = 'Inherits')
    OR (f_ElementView.rListName = 'Implements')
    OR (f_ElementView.rListName = 'Overridden')
    OR (f_ElementView.rListName = 'Attributes')
    OR (f_ElementView.rListName = 'Operations')
    OR (f_ElementView.rListName = 'Dependencies')
    OR (f_ElementView.rListName = 'Parameters')
    then
  DoDeleteElement
 else
  Assert(false);
//#UC END# *57F7B78D0250_57B57EDB003F_impl*
end;//TmsmListLikeModel.DeleteSelection

function TmsmListLikeModel.CanDeleteSelection: Boolean;
//#UC START# *57F7B79A0325_57B57EDB003F_var*
//#UC END# *57F7B79A0325_57B57EDB003F_var*
begin
//#UC START# *57F7B79A0325_57B57EDB003F_impl*
 Result := false;
 if (Self.Get_List = nil) then
  Exit;
 if (Self.Get_List.Owner = nil) then
  Exit;
 if (Selection = nil) then
  Exit;
 if Selection.Empty AND (Selection.CurrentElement = nil) then
  Exit;
 if (Selection.CurrentElement <> nil) then
  if Selection.CurrentElement.IsSameElement(Self.Get_List.Owner) then
   Exit;
 if Self.Get_List.Owner.BoolProp['IsDiagram'] then
 begin
  Result := true;
  Exit;
 end;//Self.Get_List.Owner.BoolProp['IsDiagram']
 if (f_ElementView.rListName = 'Inherits')
    OR (f_ElementView.rListName = 'Implements')
    OR (f_ElementView.rListName = 'Overridden')
    OR (f_ElementView.rListName = 'Attributes')
    OR (f_ElementView.rListName = 'Operations')
    OR (f_ElementView.rListName = 'Dependencies')
    OR (f_ElementView.rListName = 'Parameters')
    then
 begin
  Result := true;
  Exit;
 end;//f_ElementView.rListName = 'Inherits'
//#UC END# *57F7B79A0325_57B57EDB003F_impl*
end;//TmsmListLikeModel.CanDeleteSelection

procedure TmsmListLikeModel.ChangeProperties(const aKeyValues: ItfwArray);
//#UC START# *57FC23270363_57B57EDB003F_var*
//#UC END# *57FC23270363_57B57EDB003F_var*
begin
//#UC START# *57FC23270363_57B57EDB003F_impl*
 Self.Get_CurrentElement.Call(
  [TtfwStackValue_C(aKeyValues)],
  'msm:ChangeProperties'
 )
//#UC END# *57FC23270363_57B57EDB003F_impl*
end;//TmsmListLikeModel.ChangeProperties

function TmsmListLikeModel.CanChangeProperties: Boolean;
//#UC START# *57FC23540116_57B57EDB003F_var*
//#UC END# *57FC23540116_57B57EDB003F_var*
begin
//#UC START# *57FC23540116_57B57EDB003F_impl*
 Result := false;
(* if (Self.Get_List = nil) then
  Exit;*) 
 if (Self.Get_CurrentElement = nil) then
  Exit; 
(* if not Self.Get_CurrentElement.BoolProp['IsDiagram'] then
  Exit;*)
(* if (Self.Get_List.Owner.MEList['AllowedElements'].Count <= 0) then
  Exit;*)
 Result := true;
//#UC END# *57FC23540116_57B57EDB003F_impl*
end;//TmsmListLikeModel.CanChangeProperties

function TmsmListLikeModel.PropertiesForNewElement: ItfwArray;
//#UC START# *57FCC057014C_57B57EDB003F_var*
//#UC END# *57FCC057014C_57B57EDB003F_var*
begin
//#UC START# *57FCC057014C_57B57EDB003F_impl*
 TmsmWaitCursor.Make;
 Assert(Self.f_ElementView.rElement <> nil);
 if (f_ElementView.rListName = 'Attributes') then
  Result := Self.f_ElementView.rElement.CallAndGetList([TtfwStackValue_NULL], 'msm:KeyValuesForNewAttribute')
 else
 if (f_ElementView.rListName = 'Operations') then
  Result := Self.f_ElementView.rElement.CallAndGetList([TtfwStackValue_NULL], 'msm:KeyValuesForNewOperation')
 else
 if (f_ElementView.rListName = 'Dependencies') then
  Result := Self.f_ElementView.rElement.CallAndGetList([TtfwStackValue_NULL], 'msm:KeyValuesForNewDependency')
 else
 if (f_ElementView.rListName = 'Parameters') then
  Result := Self.f_ElementView.rElement.CallAndGetList([TtfwStackValue_NULL], 'msm:KeyValuesForNewParameter')
 else
 if (f_ElementView.rListName = 'Inherits') then
  Result := Self.f_ElementView.rElement.CallAndGetList([], 'msm:KeyValuesForNewInherits')
 else
 if (f_ElementView.rListName = 'Implements') then
  Result := Self.f_ElementView.rElement.CallAndGetList([], 'msm:KeyValuesForNewImplements')
 else
 if (f_ElementView.rListName = 'Overridden') then
  Result := Self.f_ElementView.rElement.CallAndGetList([], 'msm:KeyValuesForNewOverridden')
 else
 begin
  Assert(Self.Get_List <> nil);
  Assert(Self.Get_List.Owner <> nil);
  Result := Self.Get_List.Owner.CallAndGetList([], 'msm:KeyValuesForNewElement');
 end;//else
//#UC END# *57FCC057014C_57B57EDB003F_impl*
end;//TmsmListLikeModel.PropertiesForNewElement

function TmsmListLikeModel.Properties: ItfwArray;
//#UC START# *57FCC083017F_57B57EDB003F_var*
//#UC END# *57FCC083017F_57B57EDB003F_var*
begin
//#UC START# *57FCC083017F_57B57EDB003F_impl*
 TmsmWaitCursor.Make;
 Result := Self.Get_CurrentElement.CallAndGetList([], 'msm:GetProperties');
//#UC END# *57FCC083017F_57B57EDB003F_impl*
end;//TmsmListLikeModel.Properties

function TmsmListLikeModel.DragOver(const aData: IDataObject;
 const aPoint: TPoint): Boolean;
//#UC START# *57FF47AE00B4_57B57EDB003F_var*
//#UC END# *57FF47AE00B4_57B57EDB003F_var*
begin
//#UC START# *57FF47AE00B4_57B57EDB003F_impl*
 Result := false;
 if (Self.Get_List = nil) then
  Exit;
 if (Self.Get_List.Owner = nil) then
  Exit;
 if Self.Get_List.Owner.BoolProp['IsDiagram'] then
 begin
  Result := true;
  Exit;
 end;//Self.Get_List.Owner.BoolProp['IsDiagram']
 if (f_ElementView.rListName = 'Inherits')
    OR (f_ElementView.rListName = 'Implements')
    OR (f_ElementView.rListName = 'Overridden')
    OR (f_ElementView.rListName = 'Attributes')
    OR (f_ElementView.rListName = 'Operations')
    OR (f_ElementView.rListName = 'Dependencies')
    OR (f_ElementView.rListName = 'Parameters')
    then
 begin
  Result := true;
  Exit;
 end;//f_ElementView.rListName = 'Inherits'
//#UC END# *57FF47AE00B4_57B57EDB003F_impl*
end;//TmsmListLikeModel.DragOver

procedure TmsmListLikeModel.InitFields;
//#UC START# *47A042E100E2_57B57EDB003F_var*
//#UC END# *47A042E100E2_57B57EDB003F_var*
begin
//#UC START# *47A042E100E2_57B57EDB003F_impl*
 inherited;
 if (f_Selection = nil) then
  f_Selection := TmsmElementSelection.Make(Self);
//#UC END# *47A042E100E2_57B57EDB003F_impl*
end;//TmsmListLikeModel.InitFields

procedure TmsmListLikeModel.ClearFields;
begin
 Finalize(f_ElementView);
 f_Selection := nil;
 f_ElementToAction := nil;
 inherited;
end;//TmsmListLikeModel.ClearFields

end.

#1303. MVC. TmsmModel. Только код

unit msmModel;

// Модуль: "w:\common\components\gui\Garant\msm\msmModel.pas"
// Стереотип: "SimpleClass"
// Элемент модели: "TmsmModel" MUID: (57ADBFD200CA)

{$Include w:\common\components\msm.inc}

interface

uses
 l3IntfUses
 , l3ProtoObject
 , msmModels
 , msmEvents
 , ImsmEventsSubscriberList
;

type
 _msmEventsPublisher_Parent_ = Tl3ProtoObject;
 {$Include w:\common\components\gui\Garant\msm\msmEventsPublisher.imp.pas}
 _msmEventFire_Parent_ = _msmEventsPublisher_;
 {$Include w:\common\components\gui\Garant\msm\msmEventFire.imp.pas}
 TmsmModel = class(_msmEventFire_, ImsmModel, ImsmEventsPublisher)
  protected
   function As_ImsmEventsPublisher: ImsmEventsPublisher;
    {* Метод приведения нашего интерфейса к ImsmEventsPublisher }
   procedure Cleanup; override;
    {* Функция очистки полей объекта. }
  public
   class function Make: ImsmModel; reintroduce;
 end;//TmsmModel

implementation

uses
 l3ImplUses
 , SysUtils
 //#UC START# *57ADBFD200CAimpl_uses*
 //#UC END# *57ADBFD200CAimpl_uses*
;

{$Include w:\common\components\gui\Garant\msm\msmEventsPublisher.imp.pas}

{$Include w:\common\components\gui\Garant\msm\msmEventFire.imp.pas}

class function TmsmModel.Make: ImsmModel;
var
 l_Inst : TmsmModel;
begin
 l_Inst := Create;
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;//TmsmModel.Make

function TmsmModel.As_ImsmEventsPublisher: ImsmEventsPublisher;
 {* Метод приведения нашего интерфейса к ImsmEventsPublisher }
begin
 Result := Self;
end;//TmsmModel.As_ImsmEventsPublisher

procedure TmsmModel.Cleanup;
 {* Функция очистки полей объекта. }
//#UC START# *479731C50290_57ADBFD200CA_var*
//#UC END# *479731C50290_57ADBFD200CA_var*
begin
//#UC START# *479731C50290_57ADBFD200CA_impl*
 inherited;
//#UC END# *479731C50290_57ADBFD200CA_impl*
end;//TmsmModel.Cleanup

end.

#1302. MVC. ConcreteModelOwnViewController. Только код

{$IfNDef msmConcreteModelOwnViewControllerMixin_imp}

// Модуль: "w:\common\components\gui\Garant\msm\msmConcreteModelOwnViewControllerMixin.imp.pas"
// Стереотип: "Impurity"
// Элемент модели: "msmConcreteModelOwnViewControllerMixin" MUID: (57AAE9AD018B)
// Имя типа: "_msmConcreteModelOwnViewControllerMixin_"

{$Define msmConcreteModelOwnViewControllerMixin_imp}

 // _ConcreteModel_

 _msmConcreteModelOwnViewControllerMixin_ = {abstract} class(_msmConcreteModelOwnViewControllerMixin_Parent_)
  private
   f_Model: _ConcreteModel_;
  protected
   procedure Cleanup; override;
    {* Функция очистки полей объекта. }
  public
   constructor Create(const aModel: _ConcreteModel_;
    const aParent: ImsmViewParent); reintroduce; overload;
   class function Make(const aModel: _ConcreteModel_;
    const aParent: ImsmViewParent): ImsmViewController; reintroduce; overload;
   constructor Create(const aModel: _ConcreteModel_;
    const aParent: ImsmViewParent;
    const anInitContext: _InitContext_); reintroduce; overload;
   class function Make(const aModel: _ConcreteModel_;
    const aParent: ImsmViewParent;
    const anInitContext: _InitContext_): ImsmViewController; reintroduce; overload;
  protected
   property Model: _ConcreteModel_
    read f_Model;
 end;//_msmConcreteModelOwnViewControllerMixin_

{$Else msmConcreteModelOwnViewControllerMixin_imp}

{$IfNDef msmConcreteModelOwnViewControllerMixin_imp_impl}

{$Define msmConcreteModelOwnViewControllerMixin_imp_impl}

constructor _msmConcreteModelOwnViewControllerMixin_.Create(const aModel: _ConcreteModel_;
 const aParent: ImsmViewParent);
//#UC START# *57AAEA5202AA_57AAE9AD018B_var*
var
 l_InitContext : _InitContext_;
//#UC END# *57AAEA5202AA_57AAE9AD018B_var*
begin
//#UC START# *57AAEA5202AA_57AAE9AD018B_impl*
 Finalize(l_InitContext);
 System.FillChar(l_InitContext, SizeOf(l_InitContext), 0);
 Create(aModel, aParent, l_InitContext);
//#UC END# *57AAEA5202AA_57AAE9AD018B_impl*
end;//_msmConcreteModelOwnViewControllerMixin_.Create

class function _msmConcreteModelOwnViewControllerMixin_.Make(const aModel: _ConcreteModel_;
 const aParent: ImsmViewParent): ImsmViewController;
var
 l_Inst : _msmConcreteModelOwnViewControllerMixin_;
begin
 l_Inst := Create(aModel, aParent);
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;//_msmConcreteModelOwnViewControllerMixin_.Make

constructor _msmConcreteModelOwnViewControllerMixin_.Create(const aModel: _ConcreteModel_;
 const aParent: ImsmViewParent;
 const anInitContext: _InitContext_);
//#UC START# *57B466EE01D6_57AAE9AD018B_var*
//#UC END# *57B466EE01D6_57AAE9AD018B_var*
begin
//#UC START# *57B466EE01D6_57AAE9AD018B_impl*
 Assert(aModel <> nil);
 f_Model := aModel;
 inherited Create(aModel, aParent, anInitContext);
//#UC END# *57B466EE01D6_57AAE9AD018B_impl*
end;//_msmConcreteModelOwnViewControllerMixin_.Create

class function _msmConcreteModelOwnViewControllerMixin_.Make(const aModel: _ConcreteModel_;
 const aParent: ImsmViewParent;
 const anInitContext: _InitContext_): ImsmViewController;
var
 l_Inst : _msmConcreteModelOwnViewControllerMixin_;
begin
 l_Inst := Create(aModel, aParent, anInitContext);
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;//_msmConcreteModelOwnViewControllerMixin_.Make

procedure _msmConcreteModelOwnViewControllerMixin_.Cleanup;
 {* Функция очистки полей объекта. }
//#UC START# *479731C50290_57AAE9AD018B_var*
//#UC END# *479731C50290_57AAE9AD018B_var*
begin
//#UC START# *479731C50290_57AAE9AD018B_impl*
 inherited;
 f_Model := nil;
//#UC END# *479731C50290_57AAE9AD018B_impl*
end;//_msmConcreteModelOwnViewControllerMixin_.Cleanup

{$EndIf msmConcreteModelOwnViewControllerMixin_imp_impl}

{$EndIf msmConcreteModelOwnViewControllerMixin_imp}


#1301. MVC. EditViewController. Только код

{$IfNDef msmEditViewController_imp}

// Модуль: "w:\common\components\gui\Garant\msm\msmEditViewController.imp.pas"
// Стереотип: "Impurity"
// Элемент модели: "msmEditViewController" MUID: (57FBA9B70217)
// Имя типа: "_msmEditViewController_"

{$Define msmEditViewController_imp}

 _ConcreteModel_ = ImsmCaptionModel;
 _InitContext_ = TmsmEditViewInitContext;
 {$Include w:\common\components\gui\Garant\msm\msmConcreteModelOwnViewController.imp.pas}
 _msmEditViewController_ = class(_msmConcreteModelOwnViewController_)
  protected
   procedure DoTextChange(Sender: TObject); virtual;
   procedure DoCaptionChangedEvent(anEvent: TmsmEvent);
   procedure InitOwnView; override;
   procedure LinkDataToView; override;
   procedure LinkEventHandlers; override;
 end;//_msmEditViewController_

{$Else msmEditViewController_imp}

{$IfNDef msmEditViewController_imp_impl}

{$Define msmEditViewController_imp_impl}

{$Include w:\common\components\gui\Garant\msm\msmConcreteModelOwnViewController.imp.pas}

procedure _msmEditViewController_.DoTextChange(Sender: TObject);
//#UC START# *57FBAD4B01C7_57FBA9B70217_var*
//#UC END# *57FBAD4B01C7_57FBA9B70217_var*
begin
//#UC START# *57FBAD4B01C7_57FBA9B70217_impl*
 Self.Model.Caption := TtfwCStringFactory.C(OwnView.Text);
//#UC END# *57FBAD4B01C7_57FBA9B70217_impl*
end;//_msmEditViewController_.DoTextChange

procedure _msmEditViewController_.DoCaptionChangedEvent(anEvent: TmsmEvent);
//#UC START# *57FBA9B70217_57CD31A200FA_57FBA9B70217_var*
//#UC END# *57FBA9B70217_57CD31A200FA_57FBA9B70217_var*
begin
//#UC START# *57FBA9B70217_57CD31A200FA_57FBA9B70217_impl*
 inherited;
 LinkDataToView;
//#UC END# *57FBA9B70217_57CD31A200FA_57FBA9B70217_impl*
end;//_msmEditViewController_.DoCaptionChangedEvent

procedure _msmEditViewController_.InitOwnView;
//#UC START# *57ADFB33027D_57FBA9B70217_var*
//#UC END# *57ADFB33027D_57FBA9B70217_var*
begin
//#UC START# *57ADFB33027D_57FBA9B70217_impl*
 inherited;
 OwnView.AutoSelect := false;
 OwnView.OnTextChange := Self.DoTextChange;
 OwnView.Enabled := not InitContext.rDisabled;
 OwnView.ReadOnly := InitContext.rReadOnly;
//#UC END# *57ADFB33027D_57FBA9B70217_impl*
end;//_msmEditViewController_.InitOwnView

procedure _msmEditViewController_.LinkDataToView;
//#UC START# *57B6A49900F4_57FBA9B70217_var*
//#UC END# *57B6A49900F4_57FBA9B70217_var*
begin
//#UC START# *57B6A49900F4_57FBA9B70217_impl*
 inherited;
 if l3IsNil(Model.Caption) then
 begin
  if not OwnView.TextSource.HasDocument then
   OwnView.TextSource.New
  else
   OwnView.Text := '';
 end//l3IsNil(Model.Caption)
 else
  OwnView.Text := l3Str(Model.Caption);
//#UC END# *57B6A49900F4_57FBA9B70217_impl*
end;//_msmEditViewController_.LinkDataToView

procedure _msmEditViewController_.LinkEventHandlers;
begin
 inherited;
 Self.LinkEventHandler(CaptionChangedEvent.Instance, DoCaptionChangedEvent);
end;//_msmEditViewController_.LinkEventHandlers

{$EndIf msmEditViewController_imp_impl}

{$EndIf msmEditViewController_imp}


#1300. Ссылка. Я унылый программист и горжусь этим

пятница, 28 октября 2016 г.

#1299. Скриптованная бизнес-логика рисовалки моделей

По мотивам - http://programmingmindstream.blogspot.ru/2016/10/1298.html

UNIT msm.ms.dict

USES
 core.ms.dict
;

USES
 axiom_push.ms.dict
;

USES
 ModelElementsDefinition.ms.dict
;

USES
 ElemMemberPrim.ms.dict
;

USES
 ElementsRTTI.ms.dict
;

USES
 msmMetaModel.ms.dict
;

USES
 IsNil.ms.dict
;

USES
 arrays.ms.dict
;

elem_iterator NullList
 [empty] >>> Result
; // NullList

WordAlias ._NullList .NullList

elem_iterator SelfList
 [ Self ] >>> Result
; // SelfList

WordAlias ._SelfList .SelfList

elem_iterator Inner
 Cached:
 (
  Self .Children
  .join> ( Self .Constants )
  .join> ( Self .Attributes )
  .join> ( Self .Operations )
  .join> ( Self .Dependencies )
  .join> ( Self .Parameters )
 ) 
 >>> Result
; // Inner

USES
 FirstElement.ms.dict
;

STRING elem_func UpText
 Self .NameInModel >>> Result
 if ( Result .IsNil ) then
 begin
  Self .WordName >>> Result
 end // ( Result .IsNil )
 if ( Self .IsUP ) then
 begin
  VAR l_Value
  [ Self DO ]
  .map> (
    IN aValue
   RULES 
    ( aValue IsObj )
     ( aValue .Name )
    DEFAULT
     ( aValue ToPrintable )
   ; // RULES 
  ) 
  .FirstElement >>> l_Value
  [ Result ' = ' l_Value ] strings:Cat >>> Result 
 end // ( Self .IsUP )
; // UpText

STRING elem_func LinkName
 '' >>> Result
 VAR l_St
 Self .Stereotype >>> l_St
 if (
     ( l_St .NotIsNil )
     AND ( l_St .NameInModel .NotIsNil )
    ) then
 begin
  [ '<<' l_St .NameInModel '::' string:Split DROP '>>' ] strings:Cat >>> Result
 end // ( l_St .NotIsNil )
 if ( Self .NameInModel .NotIsNil ) then
 begin
  [ Result Self .NameInModel ] ' ' strings:CatSep >>> Result
 end // ( Self .NameInModel .NotIsNil )
; // LinkName

WordAlias .msm:LinkName .LinkName

WordAlias ME_EmptyStereo ME_EmptyStereo

STRING elem_func StereotypeName
 Cached:
 (
  VAR l_St
  Self .Stereotype >>> l_St
  RULES
   ( l_St ME_EmptyStereo ?== )
    ''
   (
      ( l_St .NotIsNil )
      AND ( l_St .NameInModel .NotIsNil )
   )
    begin
     [ '<<' l_St .NameInModel '>>' ] strings:Cat
    end // ( l_St .NotIsNil )
   DEFAULT 
    begin
     [ '[[' Self .MDAClassString ']]' ] strings:Cat
     // '<<default>>'
    end
  ; // RULES
 )
 >>> Result
; // StereotypeName

STRING elem_func NameNotEmpty
 Cached:
 (
  Self .NameInModel
  >>> Result
 
  if ( Result .IsNil ) then
  begin
   '(unnamed)' >>> Result
  end // ( Result .IsNil )
  Result
 )
 >>> Result
; // NameNotEmpty

STRING elem_func NameWithStereo
 Cached:
 (
  Self .NameNotEmpty >>> Result
 
  VAR l_St
  Self .StereotypeName >>> l_St
  if ( l_St .NotIsNil ) then
  begin
   [ l_St ' ' Result ] strings:Cat >>> Result
  end // ( l_St .NotIsNil )
  
  Result
 )
 >>> Result 
; // NameWithStereo

USES
 ExtValue.ms.dict
;

STRING elem_func ValueString
 '' >>> Result
 VAR l_Value
 Self .ExtValueOrValue >>> l_Value

 if ( l_Value .IsValueValid ) then
 begin
  l_Value ToPrintable >>> Result
 end // ( l_Value .IsValueValid )
; // ValueString

USES
 CountIt.ms.dict
;

ModelElement elem_func FirstOperation
 Cached:
 (
  Self .Operations
  .filter> ( .IsLocalMethod ! )
  .FirstElement
 )
 >>> Result
; // FirstOperation

elem_iterator MethodParameters
 Cached:
 (
  RULES
   ( Self .Parameters .NotIsNil )
    ( Self .Parameters )
   ( Self .IsMethod )
    ( Self .FirstOperation .Parameters )
   ( Self .IsFunction )
    ( Self .FirstOperation .Parameters )
   DEFAULT
    ( Self .Parameters )
  ; // RULES
 )
 >>> Result
; // MethodParameters

ModelElement elem_func MethodTarget
 Cached:
 (
  RULES
   ( Self .Target .NotIsNil )
    ( Self .Target )
   ( Self .IsMethod )
    ( Self .FirstOperation .Target )
   ( Self .IsFunction )
    ( Self .FirstOperation .Target )
   ( Self .IsViewLink )
    RULES
     ( Self .Target .IsNil )
      ( Self .To )
     DEFAULT
      ( Self .Target )
    ; // RULES
   DEFAULT
    ( Self .Target )
  ; // RULES
 ) 
 >>> Result
; // MethodTarget

STRING elem_func ParametersString
 '' >>> Result
 VAR l_P
 VAR l_Open
 VAR l_Close
 if ( Self .MDAClass class_Attribute == ) then
 begin
  Self .Attributes >>> l_P
  '[' >>> l_Open
  ']' >>> l_Close
 end // ( Self .MDAClass class_Attribute == )
 else
 begin
  Self .MethodParameters >>> l_P
  '(' >>> l_Open
  ')' >>> l_Close
 end // ( Self .MDAClass class_Attribute == )
 if ( l_P .NotEmpty ) then
 begin
  [
   VAR l_WasParam
   false >>> l_WasParam
   l_Open
   l_P .for> (
     IN aParam
    if l_WasParam then
     ', '
    VAR l_St
    aParam .Stereotype >>> l_St
    if ( l_St .NotIsNil ) then
    begin
     if ( l_St .NameInModel 'in' != ) then
     begin
      l_St .NameInModel ' '
     end // ( l_St .NameInModel 'in' != )
    end // ( l_St .NotIsNil )
    aParam .NameInModel
    VAR l_T
    aParam .Target >>> l_T
    VAR l_N
    if ( l_T .IsNil ) then
    begin
     'void' >>> l_N
    end // ( l_T .IsNil )
    else
    begin
     l_T .NameInModel >>> l_N
    end // ( l_T .IsNil )
    ': ' l_N
    VAR l_V
    aParam .ValueString >>> l_V
    if ( l_V .NotIsNil ) then
    begin
     ' = ' l_V
    end // ( l_V .NotIsNil )
    true >>> l_WasParam
   ) //l_P .for>
   l_Close
  ] strings:Cat >>> Result
 end // l_P .NotEmpty
; // ParametersString

STRING elem_func Signature
 Cached:
 (
  [ Self .NameNotEmpty Self .ParametersString ] strings:Cat >>> Result
  
  if ( Self .IsViewLink ) then
  begin
   if ( Self .From .NotIsNil ) then
   begin
    [ Result ' ' Self .From .NameInModel ] strings:Cat >>> Result
   end // ( Self .From .NotIsNil )
   if ( Self .To .NotIsNil ) then
   begin
    [ Result ' ==> ' Self .To .NameInModel ] strings:Cat >>> Result
   end // ( Self .To .NotIsNil )
  end // ( Self .IsViewLink )
  else
  begin
   VAR l_T
   Self .MethodTarget >>> l_T
   
   if ( l_T .NotIsNil ) then
   begin
    VAR l_Name
    l_T .NameInModel >>> l_Name
    if ( l_Name .IsNil ) then
    begin
     'void' >>> l_Name
    end // ( l_Name .IsNil )
    [ Result ': ' l_Name ] strings:Cat >>> Result
   end // ( l_T .NotIsNil )
  end // ( Self .IsViewLink )
  
  Result
 )
 >>> Result
; // Signature

WordAlias .msm:Signature .Signature

STRING elem_func NameWithStereoAndTarget
 Cached:
 (
  [ Self .StereotypeName Self .Signature ] ' ' strings:CatSep
 )
 >>> Result 
; // NameWithStereoAndTarget

STRING elem_func msm:SignatureAndValue
 Cached:
 (
  Self .msm:Signature
  >>> Result
 
  VAR l_Value
  Self .ValueString >>> l_Value
  if ( l_Value .NotIsNil ) then
  begin
   [ Result ' = ' l_Value  ] strings:Cat >>> Result
  end // ( l_Value .NotIsNil )
  Result
 )
 >>> Result 
; // msm:SignatureAndValue

STRING elem_func NameWithStereoAndTargetAndValue
 Cached:
 (
  Self .NameWithStereoAndTarget
  >>> Result
 
  VAR l_Value
  Self .ValueString >>> l_Value
  if ( l_Value .NotIsNil ) then
  begin
   [ Result ' = ' l_Value  ] strings:Cat >>> Result
  end // ( l_Value .NotIsNil )
  Result
 )
 >>> Result 
; // NameWithStereoAndTargetAndValue

STRING elem_func NameWithStereoAndTargetAndValueAndDoc
 Self .NameWithStereoAndTargetAndValue >>> Result
 VAR l_D
 Self .Documentation >>> l_D
 if ( l_D .NotIsNil ) then
 begin
  [ Result #10 ' - ' l_D ] strings:Cat >>> Result
 end // ( l_D .NotIsNil )
; // NameWithStereoAndTargetAndValueAndDoc

STRING elem_func DocumentationNotEmpty
 Self .Documentation >>> Result
 if ( Result .IsNil ) then
 begin
  'Элемент не документирован' >>> Result
 end // ( Result .IsNil )
; // DocumentationNotEmpty

BOOLEAN elem_func IsFinished
 Self .GetUP "finished" false ?!=
 >>> Result
; // IsFinished

WordAlias .DefaultShortText .NameWithStereo
//WordAlias .DefaultText .Name
//WordAlias .DefaultSearchText .Name
WordAlias .DefaultSearchText .NameInModel
WordAlias .DefaultText .NameWithStereoAndTargetAndValue
WordAlias .DefaultFullText .DefaultText
WordAlias .DefaultTextAndDoc .NameWithStereoAndTargetAndValueAndDoc

USES
 CompileTimeVar.ms.dict
;

USES
 Log.ms.dict
;

BOOLEAN CompileTime-VAR g_NeedTerminate false

PROCEDURE TerminateLoadInner
 true >>> g_NeedTerminate
 Log: 'Terminate Request'
; // TerminateLoadInner

FORWARD .msm:MainDiagram

elem_proc LoadChildInfo
 if ( g_NeedTerminate ! ) then
 begin
  Self .Stereotype DROP
  Self .NameWithStereo DROP
  Self .DefaultText DROP
  Self .Parent DROP
  Self .IsSummoned DROP
  Self .msm:MainDiagram DROP
  
  Self .Depends DROP
  Self .Inherits DROP
  Self .Implements DROP
  
  //Self .Implemented DROP
  //Self .Overridden DROP
  //Self .Dependencies DROP
  //Self .UpList DROP
  //Self .DocumentationNotEmpty DROP
  Self .Inner DROP
 end // ( g_NeedTerminate ! )
; // LoadChildInfo

elem_proc LoadInnerPrim
 if ( g_NeedTerminate ! ) then
 begin
  Self .LoadChildInfo
  Self .Inner .for> (
   if g_NeedTerminate then
   begin
    DROP
   end // g_NeedTerminate
   else
   begin
    call.me
   end // g_NeedTerminate
  ) // Self .Inner .for>
 end // ( g_NeedTerminate ! )
; // LoadInnerPrim

BOOLEAN elem_func LoadLevel
 true >>> Result
 if ( g_NeedTerminate ! ) then
 begin
  Self .LoadChildInfo
/*{  Self .Inner .for> (
   if g_NeedTerminate then
   begin
    DROP
   end // g_NeedTerminate
   else
   begin
    .LoadChildInfo
   end // g_NeedTerminate
  ) // Self .Inner .for>}*/
 end // ( g_NeedTerminate ! )
; // LoadLevel

USES
 ModelRoot.ms.dict
;

USES
 ProcessModelFiles.ms.dict
;

USES
 DictionaryByName.ms.dict
;

BOOLEAN elem_func LoadInner

 PROCEDURE LoadDictionaries
 
  PROCEDURE LoadWithString
    IN aString
   ModelRootIn .ProcessModelFiles: ( 
     STRING IN aFileName
    if ( g_NeedTerminate ! ) then 
    begin
     if ( aString aFileName FindInFile ) then
     begin
      Log: aFileName
      aFileName .DictionaryByName DROP
      500 SLEEP
     end // ( aString aFileName FindInFile )
    end // ( g_NeedTerminate ! )
   ) // ModelRootIn .ProcessModelFiles:
  ; // LoadWithString
  
  'Stereotype st_Project' LoadWithString
  'Stereotype st_Library' LoadWithString
  'Stereotype st_Unit' LoadWithString
  'Stereotype st_SimpleClass' LoadWithString
 ; // LoadDictionaries
 
 Log: 'Loading'
 true >>> Result
 Self .LoadInnerPrim
 //LoadDictionaries
 //Self .LoadInnerPrim
 if g_NeedTerminate then
 begin
  Log: 'Terminated'
 end // g_NeedTerminate
 else
 begin
  Log: 'Loaded'
 end // g_NeedTerminate
; // LoadInner

USES
 axiom:TColor
;

INTEGER elem_func msm:View:ForeColor
 RULES
  ( Self .IsProject )
   TColor::clGreen
  ( Self .IsUnit )
   TColor::clGreen
  ( Self .IsExeTarget )
   TColor::clGreen
  ( Self .IsLibrary )
   TColor::clBlue
  ( Self .IsInterfaces )
   TColor::clNavy
  ( Self .IsStereotype st_Facet )
   TColor::clNavy
  ( Self .IsStereotype st_Interface )
   TColor::clNavy
  ( Self .IsMixIn )
   TColor::clFuchsia
   //TColor::clMoneyGreen
   //TColor::clLime
  ( Self .IsSimpleClass )
   TColor::clGreen
  ( Self .IsUtilityPack )
   TColor::clRed
  ( Self .IsMixInMirror )
   TColor::clAqua
  ( Self .IsEnum )
   TColor::clOlive
  ( Self .IsTypedef )
   TColor::clMedGray
  DEFAULT
   TColor::clDefault
 ; // RULES
 >>> Result
; // msm:View:ForeColor

USES
 WordsRTTI.ms.dict
;

INTEGER elem_func StereotypeBackColor
 Cached:
 (
  VAR l_Color
  Self .StereotypeInModel .GetUP "visualization bg color" >>> l_Color
  RULES
   ( l_Color IsInt )
    l_Color
   DEFAULT
    begin
     TColor::clDefault >>> l_Color
     Self .StereotypeAncestors
     .for> (
       IN anAncestor
      VAR l_AncestorColor 
      anAncestor call.me >>> l_AncestorColor
      RULES
       (
        ( l_AncestorColor IsInt )
        AND ( l_AncestorColor TColor::clDefault != )
       ) 
        ( 
         l_AncestorColor >>> l_Color 
         BREAK-ITERATOR
        )
      ; // RULES
     ) // Self .Inherited.Words .for>
     l_Color
    end // DEFAULT
  ; // RULES
 )
 >>> Result
; // StereotypeBackColor

BOOLEAN elem_func ViewInOwnDiagram
 RULES
  ( Self .Parent .Viewed Self .Viewed ?== )
  // - мы на СВОЕЙ же диаграмме
   true
  ( Self .Parent .Viewed Self .Viewed .Parent ?!= )
  // - мы на чужой диаграмме
   false
  DEFAULT
  // - мы на диаграмме родителя
   true
 ; // RULES
 >>> Result
; // ViewInOwnDiagram
 
INTEGER elem_func msm:View:BackColor
 RULES
  ( Self .ViewInOwnDiagram ! )
   TColor::clWhite
  DEFAULT
   begin
    VAR l_Color
    Self .Stereotype .StereotypeInModel .StereotypeBackColor >>> l_Color
    RULES
     ( l_Color IsInt )
      RULES
       ( l_Color TColor::clDefault == )
        ( Self .msm:View:ForeColor )
       DEFAULT
        l_Color
      ; // RULES
     DEFAULT 
      ( Self .msm:View:ForeColor )
    ; // RULES
   end // DEFAULT
 ; // RULES  
 >>> Result
; // msm:View:BackColor

INTEGER elem_func StereotypeTextColor
 Cached:
 (
  VAR l_Color
  Self .StereotypeInModel .GetUP "visualization f-font color" >>> l_Color
  RULES
   ( l_Color IsInt )
    l_Color
   DEFAULT
    begin
     TColor::clDefault >>> l_Color
     Self .StereotypeAncestors
     .for> (
       IN anAncestor
      VAR l_AncestorColor 
      anAncestor call.me >>> l_AncestorColor
      RULES
       (
        ( l_AncestorColor IsInt )
        AND ( l_AncestorColor TColor::clDefault != )
       ) 
        ( 
         l_AncestorColor >>> l_Color 
         BREAK-ITERATOR
        )
      ; // RULES
     ) // Self .Inherited.Words .for>
     l_Color
    end // DEFAULT
  ; // RULES
 )
 >>> Result
; // StereotypeTextColor
 
INTEGER elem_func msm:View:TextColor
 RULES
  ( Self .ViewInOwnDiagram ! )
   ( Self .Stereotype .StereotypeInModel .StereotypeTextColor )
   //TColor::clNavy
  DEFAULT
   TColor::clBlack
 ; // RULES
 >>> Result
; // msm:View:TextColor

STRING elem_func msm:StereotypeDocumentation
 Cached:
 (
  VAR l_Label
  Self .Documentation >>> l_Label
  RULES
   ( l_Label .IsNil )
    ()
   ( 'перекрытие стандартного стереотипа' l_Label StartsText )
    ( '' >>> l_Label )
   ( 'нет дополнительной документации' l_Label ?== ) 
    ( '' >>> l_Label )
  ; // RULES 
  RULES
   ( l_Label .NotIsNil )
    l_Label
   DEFAULT
    begin
     '' >>> l_Label
     RULES
      ( Self IsString )
       ()
      DEFAULT
       begin
        Self .StereotypeAncestors
        .for> (
          IN anAncestor
         VAR l_AncestorLabel 
         anAncestor call.me >>> l_AncestorLabel
         RULES
          ( l_AncestorLabel .NotIsNil )
           ( 
            l_AncestorLabel >>> l_Label
            BREAK-ITERATOR
           )
         ; // RULES
        ) // .for>
       end // DEFAULT
     ; // RULES
     l_Label
    end // DEFAULT 
  ; // RULES  
 )
 >>> Result
; // msm:StereotypeDocumentation

STRING elem_func StereotypeLabelName
 Cached:
 (
  VAR l_Label
  Self .GetUP "personal label" >>> l_Label
  RULES
   ( l_Label .NotIsNil )
    l_Label
   DEFAULT
    begin
     '' >>> l_Label
     RULES
      ( Self IsString )
       ()
      DEFAULT
       begin
        Self .StereotypeAncestors
        .for> (
          IN anAncestor
         VAR l_AncestorLabel 
         anAncestor call.me >>> l_AncestorLabel
         RULES
          ( l_AncestorLabel .NotIsNil )
           ( 
            l_AncestorLabel >>> l_Label
            BREAK-ITERATOR
           )
         ; // RULES
        ) // .for>
       end // DEFAULT
     ; // RULES
     RULES
      ( l_Label .IsNil )
       begin
        RULES
         ( Self .IsStereotype: st_MDAParameter ) 
          ( 'code_param' >>> l_Label )
         ( Self .IsStereotype: st_MDAAttribute ) 
          ( 'code_attr' >>> l_Label )
        ; // RULES 
       end // ( l_Label .IsNil )
     ; // RULES
     l_Label
    end // DEFAULT 
  ; // RULES  
 )
 >>> Result
; // StereotypeLabelName

STRING elem_func msm:View:LabelName
 VAR l_Label
 Self .Stereotype .StereotypeInModel .StereotypeLabelName >>> l_Label
 RULES
  ( l_Label .NotIsNil )
   l_Label
  ( Self .IsUseCase )
   'code_use_case'
  ( Self .MDAClass class_Operation == ) 
   'code_method'
  ( Self .MDAClass class_Attribute == ) 
   'code_attr'
  ( Self .MDAClass class_Parameter == ) 
   'code_param'
  ( Self .MDAClass class_Dependency == ) 
   'code_mda_dependency'
  ( Self .MDAClass class_Inherits == ) 
   'code_mda_dependency'
  ( Self .MDAClass class_Implements == ) 
   'code_mda_dependency'
  ( Self .MDAClass class_Depends == ) 
   'code_dep'
  ( Self .IsStereotype: st_MDAParameter ) 
   'code_param'
  DEFAULT 
   ''
 ; // RESULT  
 >>> Result
; // msm:View:LabelName

STRING elem_func msm:View:VisibilityLabel
 RULES
  ( Self .Visibility PublicAccess == )
   //'public'
   ''
  ( Self .Visibility PrivateAccess == )
   'private'
  ( Self .Visibility ProtectedAccess == )
   'protected'
  ( Self .Visibility ImplementationAccess == )
   'implemented'
  ( Self .Visibility PublishedAccess == )
   'published'
  DEFAULT
   'undefined'
 ; // RULES
 >>> Result
; // msm:View:VisibilityLabel

USES
 joinWithLambded.ms.dict
;

USES
 CopyWithoutDuplicatedNames.ms.dict
;


USES
 CopyWithoutDuplicates.ms.dict
;

USES
 CopyWithoutDuplicatedUnstereotyped.ms.dict
;

USES
 StereotypeAllowedElements.ms.dict
;

EXPORTS
 StereotypeAllowedElements.ms.dict

USES
 NS.ms.dict
;

elem_iterator InnerTypes
 Self .Children
 //.join> ( Self .Constants )
 >>> Result
; // InnerTypes

USES
 Predicates.ms.dict
;

BOOLEAN elem_func IsCategory
 Self .MDAClass class_Category ==
 >>> Result
; // IsCategory

elem_iterator DeepInnerTypes
 [empty]
 RULES
  ( Self .IsNil )
   ()
  ( Self .MDAClass class_Inherits == ) 
   ()
  ( Self .MDAClass class_Implements == ) 
   ()
  ( Self .MDAClass class_Depends == ) 
   ()
  DEFAULT
   begin
    .join> ( Self .InnerTypes )
    .joinWithLambded> 
    ( Self .InnerTypes ) 
    call.me
    .filter> .Not: .IsCategory
    .CopyWithoutDuplicatedModelElements
   end // DEFAULT
 ; // RULES 
 >>> Result
; // DeepInnerTypes

EXPORTS
 DictionaryByName.ms.dict
 
USES
 CheckValue.ms.dict
;
 
: .CheckValueSafe
 if ( StackLevel > 0 ) then
  .CheckValue
; // .CheckValueSafe

USES
 IsSameModelElement.ms.dict
;

USES
 PrimitivesModel.ms.dict
;

ARRAY FUNCTION msm:Primitives
 Primitives::Delphi::System .DeepInnerTypes
 .join> ( Primitives::Primitives .DeepInnerTypes )
 >>> Result
; // msm:Primitives

WordAlias Primitives msm:Primitives

elem_iterator AccessibleTypes
 Cached:
 (
  [empty]
  RULES
   ( Self .IsNil )
    ()
   ( Self .MDAClass class_Inherits == ) 
    ()
   ( Self .MDAClass class_Implements == ) 
    ()
   ( Self .MDAClass class_Depends == ) 
    ()
   DEFAULT
    begin
     .join> ( Self .DeepInnerTypes )
     RULES
      ( Self .IsCategory )
       ()
      DEFAULT 
      begin 
       if ( Self Primitives::Delphi::System .IsSameModelElement ! ) then
       begin
        .join> ( Primitives::Delphi::System .DeepInnerTypes )
       end // ( Self Primitives::Delphi::System .IsSameModelElement ! )
       if ( Self Primitives::Primitives .IsSameModelElement ! ) then
       begin
        .join> ( Primitives::Primitives .DeepInnerTypes )
       end // ( Self Primitives::Primitives .IsSameModelElement ! )
       .join> ( Self .Parent .DeepInnerTypes )
       .join> (
        [empty]
        .joinWithLambded> 
        ( Self .Parent .Depends ) 
        .DeepInnerTypes
        .filter> ( .Visibility PublicAccess ?== )
        // - из чужих пакетов можно видеть только публичные элементы
       ) // .join>
      end // DEFAULT
     ; // RULES
     .CopyWithoutDuplicatedModelElements
    end // DEFAULT
  ; // RULES
 )  
 >>> Result
; // AccessibleTypes

WordAlias .AllowedInherits .AccessibleTypes
WordAlias .AllowedImplements .AccessibleTypes

USES
 Out.ms.dict
;

STRING FUNCTION .LabelNameToImageFileName
  STRING IN Self
 Self >>> Result 
 if ( Result .NotIsNil ) then
 begin
  VAR l_Path
  thisDictionary pop:DictionaryEx:FileName sysutils:ExtractFilePath >>> l_Path
  [ l_Path 'images' ] cPathSep strings:CatSep >>> l_Path
  l_Path sysutils:DirectoryExists ?ASSURE [ 'Директория не существует: "' l_Path '"']
  [ [ l_Path Result ] cPathSep strings:CatSep '.gif' ] strings:Cat >>> Result
  //[ 'W:\MDProcess\MDAGenerator\other\images\' Result '.gif' ] strings:Cat >>> Result
 end // ( Result .NotIsNil )
; // .LabelNameToImageFileName

STRING elem_func msm:View:ImageFileName
 Self .msm:View:LabelName 
 .LabelNameToImageFileName
 >>> Result
; // msm:View:ImageFileName

STRING elem_func msm:View:StereotypeImageFileName
 Self .StereotypeLabelName
 .LabelNameToImageFileName
 >>> Result
; // msm:View:StereotypeImageFileName

BOOLEAN elem_func IsAttribute
 Self .MDAClass class_Attribute ==
 >>> Result
; // IsAttribute

BOOLEAN elem_func IsAbstract
 Self .NSAbstraction at_abstract ==
 >>> Result
; // IsAbstract

BOOLEAN elem_func IsFinal
 Self .NSAbstraction at_final ==
 >>> Result
; // IsFinal

USES
 axiom:TPenStyle
;

INTEGER elem_func msm:View:LinkLineStyle
 Cached:
 (
  RULES
   ( Self .IsAttribute )
    TPenStyle::psSolid
   ( Self .MDAClass class_Inherits ?== )
    TPenStyle::psSolid
   ( Self .MDAClass class_Implements ?== )
    TPenStyle::psDash
   DEFAULT
    TPenStyle::psDash
  ; // RULES  
 )
 >>> Result
; // msm:View:LinkLineStyle

INTEGER elem_func msm:View:LinkLineColor
 Cached:
 (
  RULES
   ( Self .IsAttribute )
    TColor::clBlack
   ( Self .MDAClass class_Inherits ?== )
    TColor::clBlack
   ( Self .MDAClass class_Implements ?== )
    TColor::clBlack
   DEFAULT
    TColor::clDefault
  ; // RULES  
 )
 >>> Result
; // msm:View:LinkLineColor

BOOLEAN elem_func msm:View:LinkArrowIsPolygon
 Cached:
 (
  RULES
   ( Self .IsAttribute )
    false
   ( Self .MDAClass class_Inherits ?== )
    true
   ( Self .MDAClass class_Implements ?== )
    true
   DEFAULT
    false
  ; // RULES  
 )
 >>> Result
; // msm:View:LinkArrowIsPolygon

USES
 LoadOnDemand.ms.dict
;

USES
 CutSuffix.ms.dict
;

USES
 CutPrefix.ms.dict
;

USES
 Diagrams.ms.dict
;

WordAlias .msm:View:X .X
WordAlias .msm:View:Y .Y
WordAlias .msm:View:Width .Width
WordAlias .msm:View:Height .Height

WordAlias .msm:View:From .From
WordAlias .msm:View:To .To

ModelElement elem_func msm:DiagramByName
  STRING IN aName
 Self .msm:Diagrams 
 .filter> ( .Name aName SameText )
 .FirstElement
 >>> Result
; // msm:DiagramByName

ModelElement elem_func msm:DiagramByName:
  ^L IN aName
 Self aName |N .msm:DiagramByName
 >>> Result
; // msm:DiagramByName:

ModelElement elem_func msm:MainDiagram
 Self .msm:DiagramByName: main
 //Self 'main' .msm:DiagramByName
 >>> Result
; // msm:MainDiagram

BOOLEAN elem_func msm:HasMainDiagram
 Self .msm:MainDiagram .NotIsNil
 >>> Result
; // msm:HasMainDiagram

ModelElement FUNCTION .WordByDictionaryPath
  IN aPath
 aPath DictionaryAndMainWordByName
 >>> Result // - возвращаем слово 
 DROP // - выкидываем словарь
; // .WordByDictionaryPath

USES
 DictFileName.ms.dict
;

USES
 WordIsVar.ms.dict
;

USES
 GenerationFramework.ms.dict
;

elem_proc GenerateElement
 RULES
  (
   ( Self .IsSomeView )
   AND ( Self .Viewed Self ?!= )   
  ) 
    ( Self .Viewed call.me )
  ( Self .UID .IsNil ) then
    ( Self .Parent call.me )
  DEFAULT
   begin
    VAR l_DictFileName
    Self .DictFileName >>> l_DictFileName
    
    if ( l_DictFileName .IsNil ) then
    begin
     ERROR [ 'Не задано имя словаря для ' Self .Name ]
    end // ( l_DictFileName .IsNil )
    
    if ( l_DictFileName sysutils:ExtractFilePath .IsNil ) then
    begin
     [ ModelRoot .CheckDrive l_DictFileName ] cPathSep strings:CatSep >>> l_DictFileName
    end // ( l_DictFileName sysutils:ExtractFilePath .IsNil )
    
    VAR l_ListName 
    Self .Name >>> l_ListName
    l_ListName ' ' '_' string:Replace >>> l_ListName
    [ 'C:\Temp\' l_ListName '.list' ] strings:Cat >>> l_ListName
    //[ 'C:\Temp\' l_DictFileName sysutils:ExtractFileName '.list' ] strings:Cat >>> l_ListName
    l_ListName .ProcessTmpOut: (
     l_DictFileName .Out
    ) // l_ListName .ProcessTmpOut:
    l_ListName sysutils:FileExists ?ASSURE [ 'Файл не существует: "' l_ListName '"']
    VAR l_CmdFileName
    [ l_DictFileName sysutils:ExtractFilePath 'cal.cmd' ] strings:Cat >>> l_CmdFileName
    l_CmdFileName sysutils:FileExists ?ASSURE [ 'Файл не существует: "' l_CmdFileName '"']
    [ l_CmdFileName ' ' '-list:' l_ListName ' ' '-nomodel' ] strings:Cat WinExec
    //[ l_DictFileName sysutils:ExtractFilePath 'cal.cmd' ' ' l_DictFileName ' ' '-nomodel' ] strings:Cat WinExec
   end // ( Self .UID .IsNil )
 ; // RULES
; // GenerateElement

USES
 SetElementVar.ms.dict
;

EXPORTS
 SetElementVar.ms.dict
 
USES
 axiom:msm
;

elem_proc msm:SetElementVar
  STRING IN aName
  IN aValue
 aValue aName Self msm:CallSetter
; // msm:SetElementVar
  
USES
 ModelGeneration.ms.dict
;

USES
 ModelSaving.ms.dict
;

USES
 DiagramGeneration.ms.dict
;

USES
 DiagramSaving.ms.dict
;

elem_proc SaveDiagrams
 Self @ .diagram.save.script .Save
; // SaveDiagrams

elem_proc SaveModel
 Self @ .model.save.script .Save
; // SaveModel

PROCEDURE .SaveElements
  ARRAY IN anElements
 ARRAY VAR l_SavedElements 
 [] >>> l_SavedElements
 anElements .for> (
   IN anElementToSave
  RULES
   ( anElementToSave .IsView )
    ( anElementToSave .Parent >>> anElementToSave )
   ( anElementToSave .IsViewLink )
    ( anElementToSave .Parent >>> anElementToSave )
  ; // RULES
  //if ( anElementToSave .AddToArray?: l_SavedElements ) then
  begin
   RULES
    ( anElementToSave .IsDiagram )
     begin
      if ( anElementToSave /*{.Viewed}*/ .AddToArray?: l_SavedElements ) then
       ( anElementToSave .Viewed .SaveDiagrams )
     end // ( anElementToSave .IsDiagram )
    DEFAULT
     begin
      if ( anElementToSave .AddToArray?: l_SavedElements ) then
       ( anElementToSave .SaveModel ) 
     end // DEFAULT
   ; // RULES
  end // ( anElementToSave .AddToArray?: l_SavedElements )
 ) // anElements .for>
; // .SaveElements

USES
 CreateGUID.ms.dict
;

USES
 LUID.ms.dict
;

USES
 KeyValuesCreateAndDo.ms.dict
;

USES
 MEPrefix.ms.dict
;

elem_proc SetupProducerAndKey
  TtfwWord IN aProducer
  TtfwKeyWord IN aKey
 aProducer Self pop:Word:SetProducer 
 Self aKey pop:KeyWord:SetWord 
 aKey Self pop:Word:SetKey 
; // SetupProducerAndKey

PROCEDURE .ElementCreateAndDo:
  TtfwWord IN aProducer
  TtfwKeyWord IN aKey
  ^ IN aLambda
 KeyValuesCreateAndDo: (
   IN aMade
  aMade aProducer aKey .SetupProducerAndKey 
  aMade aLambda DO
 ) // KeyValuesCreateAndDo:
; // .ElementCreateAndDo:

TtfwDictionaryEx TtfwWord TYPE TDefinitor

TtfwKeyWord FUNCTION .msm:Definitor:CheckWord
  STRING IN aName
  TDefinitor IN aDefinitor
 RULES 
  ( aDefinitor Is class::TtfwWord )
   ( aName aDefinitor pop:NewWordDefinitor:CheckWord )
  ( aDefinitor Is class::TtfwDictionaryEx )
   ( aName aDefinitor pop:Dictionary:CheckWord )
  DEFAULT
   ( ERROR [ 'Несовместимый тип словаря: ' aDefinitor pop:Object:ClassName ] ) 
 ; // RULES 
 >>> Result
; // .msm:Definitor:CheckWord

FUNCTION .msm:ExistingElement
  STRING IN aName
  TDefinitor IN aDefinitor
 nil >>> Result 
 TtfwKeyWord VAR l_KeyWord
 aName aDefinitor .msm:Definitor:CheckWord >>> l_KeyWord
 if ( l_KeyWord pop:KeyWord:Word IsNil ) then
 begin
  l_KeyWord pop:KeyWord:Word >>> Result
 end // ( l_KeyWord pop:KeyWord:Word IsNil )
 else
 begin
  l_KeyWord pop:KeyWord:Word >>> Result
 end // ( l_KeyWord pop:KeyWord:Word IsNil )
; // .msm:ExistingElement

PROCEDURE .msm:NewElementAndDo:
  STRING IN aName
  TDefinitor IN aDefinitor
  TtfwWord IN aProducer
  ^ IN aLambda
 TtfwKeyWord VAR l_KeyWord
 aName aDefinitor .msm:Definitor:CheckWord >>> l_KeyWord
 if ( l_KeyWord pop:KeyWord:Word IsNil ) then
 begin
  aProducer l_KeyWord .ElementCreateAndDo: (
    IN aMade
   aMade aLambda DO 
  ) // .ElementCreateAndDo:
 end // ( l_KeyWord pop:KeyWord:Word IsNil )
 else
 begin
  ERROR [ 'Слово ' aName ' уже есть' ]
 end // ( l_KeyWord pop:KeyWord:Word IsNil )
; // .msm:NewElementAndDo:

USES
 axiom:msmModelElementList
;

elem_proc msm:AddToNamedCollection
  STRING IN aName
  ModelElement IN anItem
 VAR l_List 
 aName Self msmModelElementList:Make >>> l_List
 anItem l_List pop:msmModelElementList:Add
; // msm:AddToNamedCollection

ModelElement elem_func msm:Diagram:AddView:
  ModelElement IN aView
  INTEGER IN anX
  INTEGER IN anY
  ^ IN aLambda
 nil >>> Result 
 VAR l_UID
 CreateMUID >>> l_UID
 
 [ MEPrefix l_UID ] strings:Cat Self @ MEVIEW .msm:NewElementAndDo: (
   IN aMade
  aMade 'X' anX .msm:SetElementVar
  aMade 'Y' anY .msm:SetElementVar
  RULES
   ( aView .IsReferencedType )
    ( aMade 'Original' ( aView .Original ) .msm:SetElementVar )
   DEFAULT
    ( aMade 'Original' ( aView .Viewed ) .msm:SetElementVar )
  ; // RULES
  aMade 'Parent' Self .msm:SetElementVar
  aMade aLambda DO
  Self 'Views' aMade .msm:AddToNamedCollection
  //aMade Self .Views Array:Add
  aMade >>> Result
 ) // .msm:NewElementAndDo:
 
 //Self msm:AddChangedElement
; // msm:Diagram:AddView:

ModelElement elem_func msm:Diagram:AddViewLink:
  ModelElement IN aFrom
  ModelElement IN aTo
  ^ IN aLambda
 nil >>> Result 
 VAR l_UID
 CreateMUID >>> l_UID
 
 [ MEPrefix l_UID ] strings:Cat Self @ MEVIEWLINK .msm:NewElementAndDo: (
   IN aMade
  aMade 'From' aFrom .msm:SetElementVar
  aMade 'To' aTo .msm:SetElementVar
  aMade aLambda DO
  Self 'Views' aMade .msm:AddToNamedCollection
  //aMade Self .Views Array:Add
  aMade >>> Result
 ) // .msm:NewElementAndDo:
  
 //Self msm:AddChangedElement
; // msm:Diagram:AddViewLink:

ModelElement elem_func msm:Diagram:PasteElement
  ModelElement IN aView
  INTEGER IN anX
  INTEGER IN anY
 nil >>> Result 
 RULES  
  ( aView .IsViewLink )
   ( ERROR [ 'Вставка View от связей пока не поддерживается' ] )
  ( Self .IsDiagram )
   begin
    Self aView anX anY .msm:Diagram:AddView: (
      IN aMade
    ) // Self aView anX anY .msm:Diagram:AddView:
    >>> Result
    Self .Views .for> (
      IN aFrom
     aFrom .Inherits 
     .filter> ( aView .IsSameModelElement )
     .for> ( 
       IN aTo
      Self aFrom Result .msm:Diagram:AddViewLink: (
        IN aMade
       aMade -> Class := class_Inherits 
      ) DROP
     ) // .for>
     
     aView .Inherits 
     .filter> ( aFrom .IsSameModelElement )
     .for> ( 
       IN aTo
      Self Result aFrom .msm:Diagram:AddViewLink: (
        IN aMade
       aMade -> Class := class_Inherits 
      ) DROP
     ) // .for>
     
     aFrom .Implements
     .filter> ( aView .IsSameModelElement )
     .for> ( 
       IN aTo
      Self aFrom Result .msm:Diagram:AddViewLink: (
        IN aMade
       aMade -> Class := class_Implements
      ) DROP
     ) // .for>
     
     aView .Implements
     .filter> ( aFrom .IsSameModelElement )
     .for> ( 
       IN aTo
      Self Result aFrom .msm:Diagram:AddViewLink: (
        IN aMade
       aMade -> Class := class_Implements
      ) DROP
     ) // .for>
     
     aFrom .Depends
     .filter> ( aView .IsSameModelElement )
     .for> ( 
       IN aTo
      Self aFrom Result .msm:Diagram:AddViewLink: (
        IN aMade
       aMade -> Class := class_Depends
      ) DROP
     ) // .for>
     
     aView .Depends
     .filter> ( aFrom .IsSameModelElement )
     .for> ( 
       IN aTo
      Self Result aFrom .msm:Diagram:AddViewLink: (
        IN aMade
       aMade -> Class := class_Depends
      ) DROP
     ) // .for>
     
     aFrom .Dependencies
     .join> ( aFrom .Attributes )
     .filter> ( .Target aView .IsSameModelElement )
     .for> ( 
       IN aDep
      Self aFrom Result .msm:Diagram:AddViewLink: (
        IN aMade
       aMade 'Original' aDep .msm:SetElementVar
      ) DROP
     ) // .for>
     
     aView .Dependencies
     .join> ( aView .Attributes )
     .filter> ( .Target aFrom .IsSameModelElement )
     .for> ( 
       IN aDep
      Self Result aFrom .msm:Diagram:AddViewLink: (
        IN aMade
       aMade 'Original' aDep .msm:SetElementVar
      ) DROP
     ) // .for>
     
    ) // Self .Views .for>
   end // ( Self .IsDiagram )
  DEFAULT
   ( Self pop:Word:Producer pop:Word:Name Msg )
 ; // RULES  
; // msm:Diagram:PasteElement

USES
 DictName.ms.dict
;

USES
 DiagramExt.ms.dict
;

USES
 DiagramsRoot.ms.dict
;

USES
 DiagramsSuffix.ms.dict
;

elem_proc msm:AddDiagram
  STRING IN aDiagramName
 // - тут добавляем диаграмму
 RULES
  ( Self .IsSomeView )
   RULES
    ( Self .Viewed Self ?!= )
     begin 
      Self .Viewed call.me 
      Self msm:DeleteWordCachedValues
     end // ( Self .Viewed Self ?!= )
    DEFAULT
     ( ERROR [ 'Некуда добавлять диаграмму.' ] )
   ; // RULES
  DEFAULT
   begin
    //VAR l_DiagramsList
    //Self .msm:Diagrams >>> l_DiagramsList
    VAR l_Diagrams
    nil >>> l_Diagrams
    VAR l_UID
    Self .LUID >>> l_UID
    VAR l_DiagramDict
    [ DiagramsRoot [ l_UID DiagramExt ] strings:Cat ] cPathSep strings:CatSep DictionaryEx:CheckNamedDictionary >>> l_DiagramDict
    VAR l_DiagramsName
    [ Self .WordName DiagramsSuffix ] strings:Cat >>> l_DiagramsName
    l_DiagramsName l_DiagramDict .msm:ExistingElement >>> l_Diagrams
    if ( l_Diagrams .IsNil ) then
    begin
     l_DiagramsName l_DiagramDict @ MEDIAGRAMS .msm:NewElementAndDo: (
      IN aDiagrams
      aDiagrams >>> l_Diagrams
     ) // .msm:NewElementAndDo:
    end // l_Diagrams .IsNil
    
    VAR l_DiagramName 
    [ Self .WordName '_' aDiagramName ] strings:Cat >>> l_DiagramName
    l_DiagramName l_Diagrams @ MEDIAGRAM .msm:NewElementAndDo: (
      IN aDiagram
     aDiagram 'Name' aDiagramName .msm:SetElementVar
     aDiagram 'Original' Self .msm:SetElementVar
     aDiagram 'Views' [] .msm:SetElementVar
     //Self 'Diagrams' ( l_DiagramsList .join> [ aDiagram ] ) .msm:SetElementVar
     Self 'Diagrams' aDiagram .msm:AddToNamedCollection
     //Self 'msm:Diagrams' Self .Diagrams .msm:SetElementVar
     Self msm:DeleteWordCachedValues
     aDiagram msm:AddChangedElement
     //Self -> Diagrams .CountIt Msg
     //Self .Diagrams .CountIt Msg
     //Self .msm:Diagrams .CountIt Msg
    ) // .msm:NewElementAndDo:
    
   end // DEFAULT
 ; // RULES   
; // msm:AddDiagram

elem_proc msm:AddDiagrams
 Self 'main' .msm:AddDiagram
; // msm:AddDiagrams

elem_proc msm:CheckMainDiagram
 if ( Self .msm:HasMainDiagram ! ) then
 begin
  Self .msm:AddDiagrams
  Self msm:DeleteWordCachedValues
  // - ещё у View надо сбрасывать иначе например красная рамка не рисуется
  Self .Viewed msm:DeleteWordCachedValues
 end // ( Self .msm:HasMainDiagram ! )
; // msm:CheckMainDiagram

STRING elem_func msm:Name
 Self 'msm:Name' .ElemString >>> Result
; // msm:Name

USES
 StereotypeUPs.ms.dict
;

WordAlias .msm:Value .msm:Value

elem_iterator msm:ValueList
 Self 'msm:ValueList' .ElemList >>> Result
; // msm:Value

BOOLEAN elem_func msm:IsMemo
 RULES
  ( Self .msm:Name 'Doc' ?== )
   true
  ( Self .msm:Name 'Documentation' ?== )
   true
  ( Self .msm:Name '"Value"' ?== )
   true
  DEFAULT
   false
 ; // RULES
 >>> Result
; // msm:IsMemo

BOOLEAN elem_func msm:IsReadOnly
 RULES
  ( Self .msm:Name 'InternalName' ?== )
   true
  ( Self .msm:Name 'UID' ?== )
   true
  DEFAULT
   false
 ; // RULES
 >>> Result
; // msm:IsReadOnly

elem_iterator msm:KeyValuesForNewElementPrim
  STRING IN anElementName
  ARRAY IN anAllowedElements
 [
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'Name'
   aMade -> msm:Value := anElementName
  ) // KeyValuesCreate:
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'Stereotype'
   aMade -> msm:ValueList := anAllowedElements
  ) // KeyValuesCreate:
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'Visibility'
   aMade -> msm:ValueList := [ ME_PublicAccess ME_ProtectedAccess ME_PrivateAccess ]
  ) // KeyValuesCreate:
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'Abstraction'
   aMade -> msm:ValueList := [ ME_Regular ME_Abstract ME_Final ]
  ) // KeyValuesCreate:
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'Doc'
   aMade -> msm:Value := ''
  ) // KeyValuesCreate:
 ]
 >>> Result   
; // msm:KeyValuesForNewElementPrim

elem_iterator msm:KeyValuesForNewElement
 Self 
 'NewElement'
 Self .AllowedElements 
 .msm:KeyValuesForNewElementPrim
 >>> Result
; // msm:KeyValuesForNewElement

INTERFACE elem_func CreateTarget:
  ModelElement IN aTarget
  ^ IN aLambda
 KeyValuesCreate: (
   IN aMade
  VAR l_Types
  Self .AccessibleTypes >>> l_Types
  
  if ( aTarget .NotIsNil ) then
  begin
   [ aTarget ]
   .join> l_Types
   .CopyWithoutDuplicatedModelElements
   >>> l_Types
  end // ( aTarget .NotIsNil )
  
  aMade -> msm:Name := 'Target'
  aMade -> msm:ValueList := l_Types
  aMade -> msm:Value := aTarget
  aMade aLambda DO
 ) // KeyValuesCreate:
 >>> Result
; // CreateTarget:
  
elem_iterator msm:KeyValuesForNewAttribute
  ModelElement IN aTarget
 Self 
 'NewAttribute'
 Self .AllowedElements
 .filter> ( .IsStereotype st_MDAAttribute )
 .msm:KeyValuesForNewElementPrim
 .join> [
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'LinkType'
   aMade -> msm:ValueList := [ ME_agr ME_lnk ME_ref ]
  ) // KeyValuesCreate:
  Self aTarget .CreateTarget: (
    IN aMade
  ) // Self aTarget .CreateTarget:
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'Value'
  ) // KeyValuesCreate:
 ]
 >>> Result
; // msm:KeyValuesForNewAttribute

elem_iterator msm:KeyValuesForNewOperation
  ModelElement IN aTarget
 Self 
 'NewOperation'
 Self .AllowedElements
 .filter> ( 
   IN anElement
  RULES 
   ( anElement .IsStereotype st_MDAOperation )
    true
   ( anElement .IsStereotypeInModelKindOf: st_method )
    true
   ( anElement .IsStereotypeInModelKindOf: st_Iterator )
    true
   DEFAULT
    false 
  ; // RULES
 ) // .filter>
 .msm:KeyValuesForNewElementPrim
 .join> [
  Self aTarget .CreateTarget: (
    IN aMade
  ) // aTarget .CreateTarget:
 ]
 >>> Result
; // msm:KeyValuesForNewOperation

elem_iterator msm:KeyValuesForNewDependency
  ModelElement IN aTarget
 Self 
 ''
 Self .AllowedElements
 .filter> ( .IsStereotype st_MDADependency )
 .msm:KeyValuesForNewElementPrim
 .join> [
  Self aTarget .CreateTarget: (
    IN aMade
  ) // aTarget .CreateTarget:
 ]
 >>> Result
; // msm:KeyValuesForNewDependency

elem_iterator msm:KeyValuesForNewParameter
  ModelElement IN aTarget
 Self 
 'NewParam'
 Self .AllowedElements
 .filter> ( .IsStereotype st_MDAParameter )
 .msm:KeyValuesForNewElementPrim
 .join> [
  Self aTarget .CreateTarget: (
    IN aMade
  ) // aTarget .CreateTarget:
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'Value'
  ) // KeyValuesCreate:
 ]
 >>> Result
; // msm:KeyValuesForNewParameter

elem_iterator msm:KeyValuesForNewInherits
 [
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'AllowedInherits'
   aMade -> msm:ValueList := ( Self .AllowedInherits )
  ) // KeyValuesCreate:
 ]
 >>> Result
; // msm:KeyValuesForNewInherits

elem_iterator msm:KeyValuesForNewOverridden
 [
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'CanOverride'
   aMade -> msm:ValueList := ( Self .CanOverride )
  ) // KeyValuesCreate:
 ]
 >>> Result
; // msm:KeyValuesForNewOverridden

elem_iterator msm:KeyValuesForNewImplements
 [
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'AllowedImplements'
   aMade -> msm:ValueList := ( Self .AllowedImplements )
  ) // KeyValuesCreate:
 ]
 >>> Result
; // msm:KeyValuesForNewImplements

ModelElement FUNCTION .msm:ElementByValue
  ARRAY IN anArray
  IN aValue
 anArray 
 .filter> ( .msm:Value aValue ?== )
 .FirstElement
 >>> Result
; // .msm:ElementByValue

ModelElement FUNCTION .msm:ElementByName
  ARRAY IN anArray
  IN aName
 anArray 
 .filter> ( .NameInModel aName ?== )
 .FirstElement
 >>> Result
; // .msm:ElementByName

USES
 MDProcess_Templates.tpi.ms.dict
;

elem_iterator msm:KeyValuesForElement
 [
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'InternalName'
   aMade -> msm:Value := ( Self .WordName )
  ) // KeyValuesCreate:
  
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'UID'
   aMade -> msm:Value := ( Self .UID )
  ) // KeyValuesCreate:
  
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'Name'
   aMade -> msm:Value := ( Self .NameInModel )
  ) // KeyValuesCreate:
  VAR l_Stereotype
  Self .Stereotype .StereotypeInModel >>> l_Stereotype
  
  VAR l_AllowedElements
  Self .ParentAllowedElementsLikeMe >>> l_AllowedElements
  
  if ( l_Stereotype .IsNil ) then
  begin
   l_AllowedElements 
   .filter> .IsUnstereotypedStereo
   .FirstElement
   >>> l_Stereotype
  end // ( l_Stereotype .IsNil )
  
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'Stereotype'
   aMade -> msm:ValueList := ( 
    if ( l_Stereotype .NotIsNil ) then
    begin
     [ l_Stereotype ]
     .join> l_AllowedElements
     .CopyWithoutDuplicatedModelElements
    end
    else
    begin
     l_AllowedElements
    end // ( l_Stereotype .NotIsNil )
   )
   aMade -> msm:Value := ( aMade -> msm:ValueList l_Stereotype .NameInModel .msm:ElementByName )
  ) // KeyValuesCreate:
  
  if (
      ( l_Stereotype .IsStereotype st_MDAParameter ! )
      AND ( l_Stereotype .IsStereotype st_MDADependency ! )
     ) then
  begin
   KeyValuesCreate: (
     IN aMade
    aMade -> msm:Name := 'Visibility'
    aMade -> msm:ValueList := [ ME_PublicAccess ME_ProtectedAccess ME_PrivateAccess ]
    aMade -> msm:Value := ( aMade -> msm:ValueList  Self .Visibility .msm:ElementByValue )
   ) // KeyValuesCreate:
   KeyValuesCreate: (
     IN aMade
    aMade -> msm:Name := 'Abstraction'
    aMade -> msm:ValueList := [ ME_Regular ME_Abstract ME_Final ]
    aMade -> msm:Value := ( aMade -> msm:ValueList  Self .NSAbstraction .msm:ElementByValue )
   ) // KeyValuesCreate:
  end // ( l_Stereotype .IsStereotype st_MDAParameter ! )
  
  if ( l_Stereotype .IsStereotype st_MDAAttribute ) then
  begin
   KeyValuesCreate: (
     IN aMade
    aMade -> msm:Name := 'LinkType'
    aMade -> msm:ValueList := [ ME_agr ME_lnk ME_ref ]
    aMade -> msm:Value := ( aMade -> msm:ValueList  Self .LinkType .msm:ElementByValue )
   ) // KeyValuesCreate:
  end // ( l_Stereotype .IsStereotype st_MDAAttribute )
  
  if (
      ( l_Stereotype .IsStereotype st_MDAParameter )
      OR ( l_Stereotype .IsStereotype st_MDAAttribute )
     ) then
  begin
   KeyValuesCreate: (
     IN aMade
    aMade -> msm:Name := 'Value'
    aMade -> msm:Value := ( Self .ModelValue )
   ) // KeyValuesCreate:
  end // ( l_Stereotype .IsStereotype st_MDAParameter )
     
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'GUID'
   aMade -> msm:Value := ( Self .GUID )
  ) // KeyValuesCreate:
  
  KeyValuesCreate: (
    IN aMade
   aMade -> msm:Name := 'Doc'
   aMade -> msm:Value := ( Self .Documentation )
  ) // KeyValuesCreate:
  
  VAR l_Target
  Self .Target >>> l_Target
  
  if (
      ( l_Target .NotIsNil )
      OR ( Self .MDAClass class_Attribute ?== )
      OR ( Self .MDAClass class_Parameter ?== )
      OR ( Self .MDAClass class_Dependency ?== )
      OR ( Self .MDAClass class_Operation ?== )
     ) then
  begin
   if ( l_Target .IsNil ) then
   begin
    Primitives::void >>> l_Target
   end // ( l_Target .IsNil )
   Self l_Target .CreateTarget: (
     IN aMade
   ) // l_Target .CreateTarget:
  end // ( l_Target .NotIsNil )
  
  l_Stereotype .StereotypeUPs .for> (
    IN aUP
   KeyValuesCreate: (
     IN aMade
    VAR l_Name 
    [ '"' aUP .Name '"' ] strings:Cat >>> l_Name
    aMade -> msm:Name := l_Name
    VAR l_DefaultValue
    aUP .UPDefaultValue >>> l_DefaultValue
    
    VAR l_List
    aUP .UPValueList >>> l_List
    
    if ( l_List .NotIsNil ) then
    begin
     aMade -> msm:ValueList := l_List
    end // ( l_List .NotIsNil )
    VAR l_Value
    Self l_Name l_DefaultValue .ElemMember >>> l_Value
    if ( l_Value .IsNil ) then
    begin
     l_DefaultValue >>> l_Value
    end // ( l_Value .IsNil )
    aMade -> msm:Value := l_Value
    if ( l_List .NotIsNil ) then
    begin
     aMade -> msm:Value := ( l_List aMade -> msm:Value .msm:ElementByValue )
    end // ( l_List .NotIsNil )
   ) // KeyValuesCreate:
  ) // l_Stereotype .StereotypeUPs .for>
  
  Self .UpList 
  .filter> ( .WordName ':' string:Pos -1 != )
  .for> (
    IN aUP
   KeyValuesCreate: (
     IN aMade
    VAR l_Name
    aUP .WordName >>> l_Name
    VAR l_Value
    [ aUP DO ]
    .FirstElement >>> l_Value
    aMade -> msm:Name := l_Name 
    if ( l_Value IsBool ) then
    begin
     VAR l_List
     [ ME_False ME_True ] >>> l_List
     aMade -> msm:ValueList := l_List
     aMade -> msm:Value := l_Value
     aMade -> msm:Value := ( l_List aMade -> msm:Value .msm:ElementByValue )
    end // ( l_Value IsBool )
    else
    begin
     aMade -> msm:Value := ( l_Value ToPrintable )
    end // ( l_Value IsBool )
   ) // KeyValuesCreate: 
  ) // .for>
 ]
 >>> Result   
; // msm:KeyValuesForElement
    
elem_iterator msm:GetProperties
 Self .Viewed .msm:KeyValuesForElement
 >>> Result
; // msm:GetProperties

STRING FUNCTION .NormalizedName
  STRING IN aString
 aString '$' string:Split DROP >>> Result
; // NormalizedName

elem_proc msm:ApplyValues
  ARRAY IN aKeyValues
 RULES 
  DEFAULT
   begin
    aKeyValues .for> (
      IN anItem
     VAR l_Name
     anItem .msm:Name >>> l_Name
     VAR l_Value
     anItem .msm:Value >>> l_Value
     VAR l_ValueValue
     l_Value .msm:Value >>> l_ValueValue
     if ( l_ValueValue .NotIsNil ) then
     begin
      l_ValueValue >>> l_Value
     end // ( l_ValueValue .NotIsNil )
     
     RULES
      ( l_Name 'Doc' == )
       ( '%SUM' >>> l_Name ) 
      ( l_Name 'Documentation' == )
       ( '%SUM' >>> l_Name ) 
     ; // RULES 
     
     RULES
      ( l_Name 'InternalName' == )
      // - не даём править InternalName
       ()
      ( l_Name 'UID' == )
      // - не даём править InternalName
       ()
      ( l_Name 'Name' == )
       begin
        VAR l_NormalizedName
        l_Value .NormalizedName >>> l_NormalizedName
        Self l_Name l_NormalizedName .msm:SetElementVar
        if ( l_Value l_NormalizedName != ) then
        begin
         Self 'OriginalName' l_Value .msm:SetElementVar
        end // ( l_Value l_NormalizedName != )
        else
        begin
         Self 'OriginalName' '' .msm:SetElementVar
        end // ( l_Value l_NormalizedName != )     
       end // ( l_Name 'Name' == )
      DEFAULT
       ( Self l_Name l_Value .msm:SetElementVar )
     ; // RULES
     Self msm:DeleteWordCachedValues
     Self msm:AddChangedElement
     //msm:ClearCachedValues
    ) // aKeyValues .for> 
   end // DEFAULT 
 ; // RULES 
; // msm:ApplyValues

elem_proc msm:ChangeProperties
  ARRAY IN aKeyValues
 Self .Viewed aKeyValues .msm:ApplyValues
 Self msm:DeleteWordCachedValues
 //msm:ClearCachedValues
 // - пока опять закомментировал ибо там есть вопросы с сохранением вновь созданного элемента
; // msm:ChangeProperties

USES
 DoCache.ms.dict
;

elem_proc msm:AddToCollection
  ModelElement IN aMade
  FUNCTOR IN aLamda
 RULES 
  ( Self .IsSomeView ) 
   ( ERROR [ 'Для View пока не реализовано ' Self .Name ] )
  DEFAULT
   begin
    STRING VAR l_Name
    aLamda pop:Word:Name '.' .CutPrefix >>> l_Name
    Self l_Name aMade .msm:AddToNamedCollection
/*{    if ( Self aLamda DO .IsNil ) then
    begin
     Self ->^ l_Name ^:= []
     Self msm:DeleteWordCachedValues
    end // ( Self aLamda DO .IsNil )
    aMade Self aLamda DO Array:Add
    Self msm:AddChangedElement
    l_Name Self msm:RegetViewedLists}*/
   end // DEFAULT
 ; // RULES
; // msm:AddToCollection

elem_proc msm:AddToCollection:
  ModelElement IN aMade
  ^ IN aLamda
 Self aMade aLamda .msm:AddToCollection
; // msm:AddToCollection:

TtfwDictionaryEx elem_func OurDictionary
 Self pop:Word:KeyWord pop:KeyWord:Dictionary
 >>> Result
; // OurDictionary

ModelElement FUNCTION .msm:CheckNewElementAndDo:
  STRING IN aName
  TDefinitor IN aDefinitor
  TtfwWord IN aProducer
  ^ IN aLambda
 nil >>> Result 
 aName aDefinitor .msm:ExistingElement >>> Result
 if ( Result .IsNil ) then
 begin
  aName
  aDefinitor
  aProducer
  .msm:NewElementAndDo: (
    IN aMade
   aMade aLambda DO
   aMade >>> Result 
  ) // .msm:NewElementAndDo:
 end // ( Result .IsNil )
; // .msm:CheckNewElementAndDo:

ModelElement elem_func msm:AddImplemented
  ModelElement IN anOp
 nil >>> Result 
 [ anOp .WordName '_' Self .WordName '_impl' ] strings:Cat 
 Self .OurDictionary 
 @ MEREF 
 .msm:CheckNewElementAndDo: (
   IN aMade
  aMade -> Original := anOp 
  aMade -> OpKind := opkind_Implemented 
  Self aMade .msm:AddToCollection: .Implemented
 ) // .msm:CheckNewElementAndDo:
 >>> Result
; // msm:AddImplemented

ModelElement elem_func msm:AddInherits
  ModelElement IN anOp
 nil >>> Result 
 [ anOp .WordName '_' Self .WordName '_G' ] strings:Cat 
 Self .OurDictionary 
 @ MEREF 
 .msm:CheckNewElementAndDo: (
   IN aMade
  aMade -> Original := anOp 
  aMade -> OpKind := opkind_ReferencedType
  Self aMade .msm:AddToCollection: .Inherits
 ) // .msm:CheckNewElementAndDo:
 >>> Result
; // msm:AddInherits

ModelElement elem_func msm:AddImplements
  ModelElement IN anOp
 nil >>> Result 
 [ anOp .WordName '_' Self .WordName '_R' ] strings:Cat 
 Self .OurDictionary 
 @ MEREF 
 .msm:CheckNewElementAndDo: (
   IN aMade
  aMade -> Original := anOp 
  aMade -> OpKind := opkind_ReferencedType
  Self aMade .msm:AddToCollection: .Implements
 ) // .msm:CheckNewElementAndDo:
 >>> Result
; // msm:AddImplements

ModelElement elem_func msm:AddOverridden
  ModelElement IN anOp
 nil >>> Result 
 [ anOp .WordName '_' Self .WordName '_over' ] strings:Cat 
 Self .OurDictionary 
 @ MEREF 
 .msm:CheckNewElementAndDo: (
   IN aMade
  aMade -> Original := anOp 
  aMade -> OpKind := opkind_Overridden 
  Self aMade .msm:AddToCollection: .Overridden
 ) // .msm:CheckNewElementAndDo:
 >>> Result
; // msm:AddOverridden

elem_proc msm:AddNewInherits
  ARRAY IN aKeyValues
 VAR l_Value 
 aKeyValues 
 .filter> ( .msm:Name 'AllowedInherits' ?== )
 .FirstElement 
 .msm:Value >>> l_Value
 Self l_Value .msm:AddInherits DROP
; // msm:AddNewInherits

elem_proc msm:AddNewOverridden
  ARRAY IN aKeyValues
 VAR l_Value 
 aKeyValues 
 .filter> ( .msm:Name 'CanOverride' ?== )
 .FirstElement 
 .msm:Value >>> l_Value
 Self l_Value .msm:AddOverridden DROP
; // msm:AddNewOverridden

elem_proc msm:AddNewImplements
  ARRAY IN aKeyValues
 VAR l_Value 
 aKeyValues 
 .filter> ( .msm:Name 'AllowedImplements' ?== )
 .FirstElement 
 .msm:Value >>> l_Value
 Self l_Value .msm:AddImplements DROP
; // msm:AddNewImplements

ModelElement elem_func msm:AddElement
  STRING IN aName
  ModelElement IN aStereotype
  ARRAY IN aKeyValues
 nil >>> Result 
 BOOLEAN VAR l_IsSubRoot
 RULES
  ( aStereotype .IsStereotype st_MDACategory )
   true
  ( aStereotype .IsStereotypeInModelKindOf: st_UtilityPack )
   true
  ( Self .MDAClass class_Class == )
   false
  ( Self .MDAClass class_Const == )
   false
  ( aStereotype .IsStereotypeInModelKindOf: st_SimpleClass )
   true
  ( aStereotype .IsStereotypeInModelKindOf: st_Impurity )
   true
  DEFAULT
   false
 ; // RULES
 >>> l_IsSubRoot
 
 VAR l_UID
 CreateMUID >>> l_UID
 
 [ MEPrefix l_UID ] strings:Cat
 RULES
  l_IsSubRoot
   ( [ l_UID cModelScript ] strings:Cat DictionaryEx:CheckNamedDictionary )
  DEFAULT
   ( Self .OurDictionary )
 ; // RULES 
 @ ME .msm:NewElementAndDo: (
    IN aMade
   RULES
    ( aStereotype .IsStereotype st_MDACategory )
     ( aMade -> Class := class_Category )
    ( aStereotype .IsStereotype st_MDAOperation )
     ( aMade -> Class := class_Operation )
    ( aStereotype .IsStereotype st_MDAAttribute )
     ( aMade -> Class := class_Attribute )
    ( aStereotype .IsStereotype st_MDADependency )
     ( aMade -> Class := class_Dependency )
    ( aStereotype .IsStereotype st_MDAParameter )
     ( aMade -> Class := class_Parameter )
    ( aStereotype .IsStereotypeInModelKindOf: st_method ) 
     ( aMade -> Class := class_Operation )
    ( aStereotype .IsStereotypeInModelKindOf: st_Iterator ) 
     ( aMade -> Class := class_Operation )
    ( aStereotype .IsStereotype st_MDAClass )
     ( aMade -> Class := class_Class )
    DEFAULT
     begin
      ERROR [ 'Непонятный стереотип ' aStereotype .Stereotype .Name ]
     end // DEFAULT
   ; // RULES
   aMade -> IsSubRoot := l_IsSubRoot
   aMade -> UID := l_UID
   VAR l_Name
   aName .NormalizedName >>> l_Name
   aMade 'Name' l_Name .msm:SetElementVar
   if ( aName l_Name != ) then
   begin
    aMade 'OriginalName' aName .msm:SetElementVar
   end // ( aName l_Name != )
   aMade 'Stereotype' aStereotype .msm:SetElementVar
   aMade 'Parent' Self .msm:SetElementVar
   
   if (
       ( aStereotype .IsStereotype st_MDAParameter ! )
       AND ( aStereotype .IsStereotype st_MDADependency ! )
      ) then
   begin   
    aMade 'Visibility' PublicAccess .msm:SetElementVar
    aMade 'Abstraction' at_regular .msm:SetElementVar
   end // ( aStereotype .IsStereotype st_MDAParameter ! )
   
   // - вообще это надо брать из стереотипа
   aMade aKeyValues .msm:ApplyValues
   
   RULES
    ( aMade .MDAClass class_Parameter ?== )
     ( Self aMade .msm:AddToCollection: .Parameters )
    ( aMade .MDAClass class_Dependency ?== )
     ( Self aMade .msm:AddToCollection: .Dependencies )
    ( aMade .MDAClass class_Attribute ?== )
     ( Self aMade .msm:AddToCollection: .Attributes )
    ( aMade .MDAClass class_Operation ?== )
     ( Self aMade .msm:AddToCollection: .Operations )
    ( aStereotype .IsStereotypeInModelKindOf: st_method )
     ( Self aMade .msm:AddToCollection: .Operations )
    ( aStereotype .IsStereotypeInModelKindOf: st_Iterator )
     ( Self aMade .msm:AddToCollection: .Operations )
    DEFAULT
     ( Self aMade .msm:AddToCollection: .Children )
   ; // RULES  
   
   aMade >>> Result
 ) // .msm:NewElementAndDo:
 
 Self msm:AddChangedElement
 // - надо сохранять и родителя
 Result msm:AddChangedElement
 // - и ребёнка
; // msm:AddElement

ModelElement elem_func msm:Diagram:AddElement
  STRING IN aName
  ModelElement IN aStereotype
  ARRAY IN aKeyValues
 nil >>> Result
 RULES  
  ( Self .IsDiagram )
   begin
    VAR l_Original
    Self .Viewed >>> l_Original
   
    l_Original aName aStereotype aKeyValues .msm:AddElement >>> Result

    Result .msm:AddDiagrams
    
    Self Result 10 10 .msm:Diagram:PasteElement >>> Result
   end // ( Self .IsDiagram )
  DEFAULT
   ( Self pop:Word:Producer pop:Word:Name Msg )
 ; // RULES  
; // msm:Diagram:AddElement

elem_iterator msm:Diagram:PasteElements
  ARRAY IN anElements
 [] >>> Result 
 RULES  
  ( Self .IsDiagram )
   begin
    anElements
    .filter> .Not: .IsViewLink
    .for> (
      IN aView
     Self 
     aView 
     aView .X 10 +
     aView .Y 10 +
     .msm:Diagram:PasteElement .AddToArray: Result
    ) // .for>
   end // ( Self .IsDiagram )
  DEFAULT
   ( Self pop:Word:Producer pop:Word:Name Msg )
 ; // RULES  
; // msm:Diagram:PasteElements

ModelElement FUNCTION .FindWord
  ARRAY IN aWords
  STRING IN aName
 aWords 
 .filter> ( .NameInModel aName SameText )
 .filter> ( pop:Word:Producer @ ME ?== )
 .FirstElement
 >>> Result
; // .FindWord

USES
 Chars.ms.dict
;

BOOLEAN FUNCTION .TryLoadWord
  STRING IN aName
  STRING IN aPath

 : DoFile
   STRING IN anItem
  if ( [ 'MEPROP OriginalName ' cQuote aName cQuote ] strings:Cat anItem FindInFile ) then
  begin
   true >>> Result
   anItem .DictionaryByName DROP
  end // ( aName anItem FindInFile )
  else
  if ( [ 'MEPROP Name ' cQuote aName cQuote ] strings:Cat anItem FindInFile ) then
  begin
   true >>> Result
   anItem .DictionaryByName DROP
  end // ( aName anItem FindInFile )
 ; // DoFile
 
 false >>> Result
 aPath .ProcessModelFiles: DoFile
; // .TryLoadWord

BOOLEAN FUNCTION .TryLoadWordByUID
  STRING IN anUID
  STRING IN aPath

 : DoFile
   STRING IN anItem
  if ( [ 'MEPROP UID ' cQuote anUID cQuote ] strings:Cat anItem FindInFile ) then
  begin
   true >>> Result
   anItem .DictionaryByName DROP
  end // ( .. anItem FindInFile )
 ; // DoFile
 
 false >>> Result
 aPath .ProcessModelFiles: DoFile
; // .TryLoadWordByUID

EXPORTS
 arrays.ms.dict
 
EXPORTS
 ElementsRTTI.ms.dict
 
EXPORTS
 CheckValue.ms.dict

EXPORTS
 msmMetaModel.ms.dict
 
USES
 ElemMemberPrim.ms.dict
;
 
EXPORTS
 ElemMemberPrim.ms.dict
 
EXPORTS
 Diagrams.ms.dict
 
EXPORTS
 NS.ms.dict