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.
Заметки о тестировании, программировании и прочий "поток сознания", который жалко писать "в стол"
понедельник, 31 октября 2016 г.
#1312. MVC. TmsmCurrentElementSynchronizeBinding. Только код
#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}
пятница, 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