четверг, 29 декабря 2016 г.

#1330. Цитата. Win64

"GetMem лучше заменить на VirtualAlloc MEM_RESERVE, тогда это можно и в релиз, т.к. "бесплатно".

Ну и, по-хорошему, делать это надо, перебрав свободные участки в первых двух гигах и явно указывать адрес резервирования. Ибо не факт, что система даст память в первых двух гигах при запросе без явного указания адреса."

Это чтобы тестировать указатели с большими адресами.

среда, 28 декабря 2016 г.

#1329. Багель про локальные callback'и

#1328. Win64. Небольшой хинт

Есть небольшой хинт. Весь ассемблер для начала тупо изменяем на assert. Под ifdef CPU64. И запускаем тесты. И разбираемся уже по факту. По мне - сильно время экономит.

#1327. Ссылка. Прислали. Debug Engine

https://github.com/MahdiSafsafi/DebugEngine

"Случайно вот наткнулся - библиотечка у чувака со всякими низкоуровневыми штуками на дельфях (x32 + x64), может быть тебе что-нибудь оттуда где-нибудь пригодится.'

Посмотрел. Там есть что почерпнуть.

Цитата оттуда:

DebugEngine

What is DebugEngine ?

DebugEngine is a collection of utils related to debug stuff (stack trace, CPU registers snaphot, debug info,...). Basically, I started to write a commercial error log plugin for Delphi, then I noticed that my internal framework got bigger and bigger. So I decided to share it with the community in hope it will be useful.

Features:

DebugEngine has a lot of functions and utilities allowing to you to do for example:

Getting started:

Please refer to the Wiki page and see Demo included with the library. Note that all public functions are documented (XML doc). However if you don't understand something, please feel free to contact me.

И:

Getting address of symbol:

Use GetSymbolAddress function to get address of symbol.
function GetSymbolAddress(ModuleHandle: THandle; const UnitName, SymbolName: string): Pointer;
  • ModuleHandle = Module handle where the symbol is located. If you pass zero (0), the function will use the current module handle.
  • UnitName = Optional, unit name where the symbol was declared. This is useful when many units declare the same symbol.
  • SymbolName = symbol name.
  • Return value = If the function succeeds, the return value is the address of the symbol. Otherwise it returns nil.
Example:
var
  P: Pointer;
begin
  { Private variable System.MemoryManager }
  P := GetSymbolAddress(0, 'System', 'MemoryManager');
  { Private method System.SetExceptionHandler }
  P := GetSymbolAddress(0, '', 'SetExceptionHandler'); 
  { Protected method TCustomForm.CloseModal } 
  P := GetSymbolAddress(0, '', 'TCustomForm.CloseModal');
  { Windows api }
  P := GetSymbolAddress(GetModuleHandle(user32), '', 'MessageBoxA');
end;

Using DebugEngine stack trace when error occurs:

All what you need to do is to include DebugEngine.HookException unit into your project. And each time an error occurs, you will be able to get the stack trace from the point where the error occurred.
uses 
  DebugEngine.HookException;

{...}

procedure Foo;
begin
  try
    DoSomething;
  except
    on E: Exception do
      ShowMessage(E.StackTrace);
  end;
end;

Disasm and comment function:

If you plan to use this feature, you need first to update UnivDisasm.Config.inc file and tell UnivDisasm that you need display feature (Define NEED_DISPLAY). By default, I turned this option off just for optimization. So if you are going to use Disasm and comment feature, you should enable it again.
function DisasmAndCommentFunction(FunctionStartAddress: Pointer; var FunctionEndAddress: Pointer; CallBackFunction: TDisasmCallBack; UserData: Pointer)
  : Boolean;
  • FunctionStartAddress = Function address that you want to disasm.
  • FunctionEndAddress = End address where the disasm will stop. If not specified, UnivDisasm will break on the first retinstruction.
  • CallBackFunction = A pointer to TDisasmCallBack function. This function will be called by DisasmAndCommentFunction each time it decodes an instruction.
  • UserData = Optional data to pass to CallBackFunction function.
Example:

procedure DisasmCallBack(var Info: TDisasmInfo; UserData: Pointer);
var
  S: String;
begin
  with TMemo(UserData).Lines, Info do
  begin
    S := Format('[$%p]:    %s', [Address, InstStr]);
    if not comment.IsEmpty then
      S := S + '    ; ' + comment;
    Add(S);
  end;
end;

var
  P: Pointer;
begin
  P := nil;
  {LogMem = TMemo}
  LogMem.Clear;
  LogMem.Lines.BeginUpdate;
  try
    DisasmAndCommentFunction(@TMain.BtnLegRegSnapClick, P, DisasmCallBack, LogMem);
  finally
    LogMem.Lines.EndUpdate;
  end;

#1326. Портирование под Win64

В последний свой рабочий день уходящего года закончил портирование основной функциональности под 64 бита.

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

#1325. Коротко. Прогресс портирования под Win64. ImageEn

Собрал с 64-хбитным ImageEn. Пришлось найти 64-битную dll на просторах интернета.

Исправил несколько ошибок. В частности - Seek за конец потока при определении формата картинки в потоке.

Собрать без dll - с испольлование родных 64-хбитных libpng, zlib из C-шного кода - пока не получилось.

Вообще хочу отказаться от ImageEn - в пользу "нативных" средств Delphi и/или GDI+. Т.к. ImageEn в основном используется для чтения/записи различных графических форматов.

среда, 14 декабря 2016 г.

#1324. Коротко. Прогресс портирования под Win64

Портирую наши проекты под Win64.

1. Собрал и запустил консольные тесты. Все прошли.
2. Собрал и запустил скриптованные консольные тесты. Все прошли.
3. Собрал и запустил скриптованные тесты под GUITestRunner. Все прошли.
4. Собрал и запустил небольшой набор GUI-тестов. Все прошли.
5. Сейчас работаю над собираемостью всех имеющихся в наличии GUI-тестов.
6. Собрал читатели/писатели формата EVD, а также его фильтры. Тесты пока не запускал.
7. Портировал под Win 64 наши доработки DUnit.
8. Портировал кодогенерацию.

Попутно разобрался с соглашениями о вызовах под Win 64.

Научился делать заглушки (stubs) для вызовов локальных функций из итераторов без использования анонимных функций.

Часть локальных функций заменил на анонимные. Есть мыли как сделать прозрачное преобразование одного в другое.

Порадовал тот факт, что компилятор не даёт приводить Integer и Cardinal к Pointer. Это позволяет отсечь много ошибок уже на этапе компиляции.

Описанный процесс занял порядка полутора-двух месяцев (тут зависит - считать ли дополнительную подготовительную работу).

Для портирования использовал Delphi XE4, т.к. у нас на неё куплены лицензии.

Из стороннего пока не собраны - miniLZO и ImageEn. Там линкуются объектные файлы 64-хбитную версию которых надо где-то найти.

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

#1323. Коротко. О соглашениях о вызовах под Win64

Ссылка на MSDN - https://msdn.microsoft.com/en-us/library/windows/hardware/ff561499(v=vs.85).aspx

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

Под Win64 модель передачи параметров только одна.

Т.е. stdcall, pascal, cdecl, register - эквивалентны.

Параметры передаются через регистры в порядке - rcx, rdx, r8, r9. Остальные через стек.

Если значение не помещается в регистр, то оно кладется на стек, а в регистре передается указатель на это значение.

Возвращаемое значение помещается в rax. Если оно целочисленное (Integer) или указатель (Pointer).

Вещественные числа возвращаются через регистр xmm0.

Регистры rax, rcx, rdx, r8-r11 - могут изменяться внутри вызываемой функции.

Регистры rbx, rbp, rdi, rsi, r12-r15 - должны сохранять своё значение при работе вызываемой функции.

Также спецификация вызова обязует вызывающую процедуру распределять место в собственном стековом фрейме для временного сохранения (spill) значений тех параметров, которые переданы через регистры.

(Оригинальная цитата - "The caller reserves space on the stack for arguments passed in registers. The called function can use this space to spill the contents of registers to the stack.")

Вызываемая процедура может использовать это место по своему усмотрению.

Пример ручного резервирования:

procedure TMethodHandlerInstance.Handler(Params: Pointer);
asm
        .NOFRAME
        SUB     RSP, 28H // - выделяем место в стеке
        CALL    InternalHandler // InternalHandler - может использовать это место адресуясь через [RSP+Offset]
        MOV     [RSP], RAX // - в этих двух строках ещё попользовали отведённое место
        MOVSD   XMM0, [RSP] // в качестве собственной переменной
        ADD     RSP, 28H // - возвращаем место в стеке
end;

Листьевые процедуры метятся директивой .NOFRAME, которая гарантирует, что компилятор не будет распределять стековый фрейм.

Локальные процедуры обрабатываются особо. В регистр rcx помещается значение регистра базы (rbp) той процедуры в которую вложена локальная процедура.

От этой базы адресуются локальные переменные охватывающей процедуры.

Таким образом вложенная локальная процедура получает доступ к локальным переменным охватывающей процедуры.

На основании этой информации можно строить заглушки для вызовов локальных функций вместо анонимных.

Ссылки:
http://18delphi.blogspot.ru/2013/03/blog-post_5929.html
http://18delphi.blogspot.ru/2013/07/embarcadero.html

Подсмотреть направление исследований можно в коде Embarcadero. В методе MakeObjectInstance.

Позже я выложу примеры кода.




пятница, 9 декабря 2016 г.

#1322. Ссылка. Китайский ORM генератор

http://grandruru.blogspot.tw/2016/02/delphi-orm-generator.html

Попробывал, нашел баг, вышел апдейт. Должны были починить. Сама идея мне нравится, как нибудь распишу подробнее свое виденее.

Написан под Windows 10.

Как его запустить(и вообще возможно ли) без Windows Store, я пока не знаю. 

пятница, 2 декабря 2016 г.

#1321. Только код. Заготовочка для заглушек для вызова локальных функций под Win64

program Lambda;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

function GetRBP: Pointer; assembler;
asm
   .NOFRAME
   mov rax, rbp // - тут получаем текущую базу локальных переменных
//   ret
//   mov r8, rdx
//   mov rdx, rcx
//   mov rbp, [RIP+0]
//   jmp [RIP+0]
//   mov rcx, $ffffffffffffffff
end;

function l3LocalStubPrim(aRBP: Pointer; anAction: Pointer): Pointer;
{$WriteableConst On}
const
 StubCode : array [0 .. 29 + 8] of Byte = (
  $49, $89, $D0, // mov r8, edx // - у глобальной процедуры параметры передаются через ecx, edx
  $48, $89, $CA, // mov edx, ecx // а у локальной через edx, r8
  $48, $B9, // mov rcx, 0000000000000000 // - в rcx - база
  $00, $00, $00, $00, $00, $00, $00, $00,
  $FF, $25, $00, $00, $00, $00, // jmp [RIP+0] // - тут переход на anAction
  $00, $00, $00, $00, $00, $00, $00, $00

  , $00, $00, $00, $00, $00, $00, $00, $00
 ); // StubCode
begin
 Move(aRBP, StubCode[8], SizeOf(aRBP)); // - конкретное значение rbp
 Move(anAction, StubCode[22], SizeOf(anAction)); // - конкретное значение anAction
 Result := @StubCode;
end;

function l3LocalStub(anAction: Pointer): Pointer; assembler;
asm
   .NOFRAME
   call GetRBP
   mov rdx, rcx
   mov rcx, rax
   jmp l3LocalStubPrim
   //call l3LocalStubPrim
end;

type
 TProc1 = procedure (A: Integer);
 TProc2 = procedure (A: Integer; B: Integer);

procedure Call1(aProc: TProc1);
begin
 aProc(12345);
end;

procedure Call2(aProc: TProc2);
begin
 aProc(12345, 789);
end;

procedure Test;

var
 l_S : String;

 procedure Local1(aStr: Integer);
 var
  l_S1 : String;
  l_S2 : String;
 begin
  l_S1 := 'YYY';
  l_S2 := l_S + l_S1;
  l_S2 := l_S2 + IntToStr(aStr);
  WriteLn(l_S2);
 end;

 procedure Local2(A: Integer; B: Integer);
 begin
  WriteLn(A);
  WriteLn(B);
 end;

var
 l_RBP : NativeUInt;
 l_P : Pointer;
begin
 l_RBP := NativeUInt(GetRBP);
 l_S := 'XXX';
 Local1(10);
 Local2(10, 0);
 Call1(l3LocalStubPrim(GetRBP, @Local1));
 Call1(l3LocalStub(@Local1));
 Call2(l3LocalStubPrim(GetRBP, @Local2));
 Call2(l3LocalStub(@Local2));
 ReadLn;
end;

begin
  try
    Test;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.


среда, 9 ноября 2016 г.

#1315. Продолжение "приколов". "Delphi по-немецки"

https://translate.google.com/translate?hl=&sl=ru&tl=de&u=http%3A%2F%2Fprogrammingmindstream.blogspot.fr%2F2014%2F11%2Fmindstream.html&sandbox=1

  Einheit TestmsSerializeController;

 Schnittstelle

 Anwendungen
   Testframework,
   msSerializeController,
   msDiagramm,
   msShape,
   msRegisteredShapes,
   System.Types,
   System.Classes
   ;

 Typ
   TmsShapeClassCheck = TmsShapeClassLambda;

   TmsShapeTestPrim = Klasse abstrakt (TTestCase)
   Öffentlichkeit
     Klasse Verfahren CheckShapes (aÜberprüfen und berichtigen: TmsShapeClassCheck);
   Ende; // TmsShapeTestPrim

   TmsShapeTestContext = record
    rMethodName: string;
    rSeed: Integer;
    rDiagrammName: String;
    rShapesCount: Integer;
    rShapeClass: RmsShape;
    Erstellen Konstruktor (aMethodName: string; aSeed: Integer; aDiagrammName: String; aShapesCount: Integer; aShapeClass: RmsShape);
   Ende; // TmsShapeTestContext

   TmsFileLambda = Verweis auf das Verfahren (aFile: TFileStream);
   TmsDiagrammCheck = Verweis auf das Verfahren (aDiagramm: TmsDiagramm);

   TestTmsSerializeControllerPrim = Klasse abstrakt (TmsShapeTestPrim)
   geschützt
    f_Coords: Array von TPoint;
    f_Context: TmsShapeTestContext;
   geschützt
     Verfahren SetUp;  außer Kraft setzen;
     Verfahren CheckFileWithEtalon (const AFileName: String);
     Funktion MakeFileName (const aTestName: String; aShapeClass: RmsShape): String;
     Funktion TestResultsFileName (aShapeClass: RmsShape): String;
     Verfahren SaveDiagrammAndCheck (aShapeClass: RmsShape; aDiagramm: TmsDiagramm);
     Funktion ShapesCount: Integer;
     Verfahren CreateDiagrammAndCheck (aÜberprüfen und berichtigen: TmsDiagrammCheck; const aName: String);
     Verfahren CreateDiagrammWithShapeAndSaveAndCheck (aShapeClass: RmsShape);
     Funktion TestSerializeMethodName: String;  virtuelle;
     Verfahren DeserializeDiargammAndCheck (aÜberprüfen und berichtigen: TmsDiagrammCheck; aShapeClass: RmsShape);
     Verfahren TestDeSerializeForShapeClass (aShapeClass: RmsShape);
     Verfahren TestDeSerializeViaShapeCheckForShapeClass (aShapeClass: RmsShape);
     Funktion ShapeClass: RmsShape;
     Verfahren OutToFileAndCheck (aLambda: TmsFileLambda);
   Öffentlichkeit
    Erstellen Konstruktor (const aContext: TmsShapeTestContext);  virtuelle;
   Ende; // TestTmsSerializeControllerPrim

   TestTmsSerializeController = Klasse abstrakt (TestTmsSerializeControllerPrim)
   veröffentlicht
     Verfahren TestSerialize;
     Verfahren TestDeSerialize;
     Verfahren TestDeSerializeViaShapeCheck;
     Verfahren TestShapeName;
     Verfahren TestDiagrammName;
   Ende; // TestTmsSerializeController

   TmsParametrizedShapeTest = class (TestTmsSerializeController)
   privat
    f_TestSerializeMethodName: String;
   geschützt
     Funktion TestSerializeMethodName: String;  außer Kraft setzen;
   Öffentlichkeit
    Erstellen Konstruktor (const aContext: TmsShapeTestContext);  außer Kraft setzen;
   Ende; // TmsParametrizedShapeTest

   RmsParametrizedShapeTest = Klasse von TmsParametrizedShapeTest;

   TmsParametrizedShapeTestSuite = class (TTestSuite)
   privat
    Konstruktor CreatePrim;
   Öffentlichkeit
    Verfahren AddTests (Testklasse: TTestCaseClass);  außer Kraft setzen;
    Erstellen Sie Klassenfunktion: ITest;
   Ende; // TmsParametrizedShapeTestSuite

 Implementierung

  Anwendungen
   System.SysUtils,
   msTriangle,
   msRectangle,
   msCircle,
   msRoundedRectangle,
   msMover,
   Winapi.Windows,
   System.Rtti,
   System.TypInfo,
   FMX.Objects
   ;

 Funktion TestTmsSerializeControllerPrim.MakeFileName (const aTestName: String; aShapeClass: RmsShape): String;
 var
  l_Folder: String;
 beginnen
  l_Folder: = ExtractFilePath (ParamStr (0)) + 'Test- ergebnisse \';
  Force (l_Folder);
  Ergebnis: = l_Folder + Class + '_' + aTestName + '_' + aShapeClass.ClassName + '.json';
 Ende;

 Verfahren TestTmsSerializeControllerPrim.CheckFileWithEtalon (const AFileName: String);
 var
  l_FileSerialized, l_FileEtalon: TStringList;
  l_FileNameEtalon: String;
 beginnen
  l_FileNameEtalon: = AFileName + '.etalon' + ExtractFileExt (AFileName);
  wenn FileExists (l_FileNameEtalon), dann
  beginnen
   l_FileSerialized: = TStringList.Create;
   l_FileSerialized.LoadFromFile (AFileName);

   l_FileEtalon: = TStringList.Create;
   l_FileEtalon.LoadFromFile (l_FileNameEtalon);

   CheckTrue (l_FileEtalon.Equals (l_FileSerialized));

   FreeAndNil (l_FileSerialized);
   FreeAndNil (l_FileEtalon);
  Ende // FileExists (l_FileNameEtalon)
  sonst
  beginnen
   Copyfile (PWideChar (AFileName), PWideChar (l_FileNameEtalon), True);
  Ende; // FileExists (l_FileNameEtalon)
 Ende;

 Funktion TestTmsSerializeControllerPrim.TestResultsFileName (aShapeClass: RmsShape): String;
 beginnen
  Ergebnis: = MakeFileName (Name, aShapeClass);
 Ende;

 Verfahren TestTmsSerializeControllerPrim.SaveDiagrammAndCheck (aShapeClass: RmsShape; aDiagramm: TmsDiagramm);
 var
  l_FileNameTest: String;
 beginnen
  l_FileNameTest: = TestResultsFileName (aShapeClass);
  TmsSerializeController.Serialize (l_FileNameTest, aDiagramm);
  CheckFileWithEtalon (l_FileNameTest);
 Ende;

 Funktion TestTmsSerializeControllerPrim.ShapesCount: Integer;
 beginnen
  Ergebnis: = f_Context.rShapesCount;
 Ende;

 Konstruktor TmsShapeTestContext.Create (aMethodName: string; aSeed: Integer; aDiagrammName: String; aShapesCount: Integer; aShapeClass: RmsShape);
 beginnen
  rMethodName: = aMethodName;
  rSeed: = aSeed;
  rDiagrammName: = aDiagrammName;
  rShapesCount: = aShapesCount;
  rShapeClass: = aShapeClass
 Ende;

 Verfahren TestTmsSerializeControllerPrim.SetUp;
 var
  l_Index: Integer;
  L_X: Integer;
  l_Y: Integer;
 beginnen
  geerbt;
  RandSeed: = f_Context.rSeed;
  SetLength (f_Coords, ShapesCount);
  für l_Index: = 0 bis Pred (ShapesCount) tun
  beginnen
   L_X: = Random (100);
   l_Y: = Random (200);
   f_Coords [l_Index]: = TPoint.Create (L_X, l_Y);
  Ende; // für l_Index
 Ende;

 Verfahren TestTmsSerializeControllerPrim.CreateDiagrammAndCheck (aÜberprüfen und berichtigen: TmsDiagrammCheck; const aName: String);
 var
  l_Diagramm: TmsDiagramm;
  l_Image: TImage;
 beginnen
  l_Image: = nil;
  versuchen
   l_Diagramm: = TmsDiagramm.Create (l_Image, aName);
   versuchen
    aÜberprüfen und berichtigen (l_Diagramm);
   schließlich
    FreeAndNil (l_Diagramm);
   Ende; // try..finally
  schließlich
   FreeAndNil (l_Image);
  Ende; // try..finally
 Ende;

 Verfahren TestTmsSerializeControllerPrim.CreateDiagrammWithShapeAndSaveAndCheck (aShapeClass: RmsShape);
 beginnen
  CreateDiagrammAndCheck (
   Verfahren (aDiagramm: TmsDiagramm)
   var
    L_p: TPoint;
   beginnen
    für L_p in f_Coords tun
     aDiagramm.ShapeList.Add (aShapeClass.Create (TmsMakeShapeContext.Create (TPointF.Create (l_P.X, l_P.Y), nil)));
    SaveDiagrammAndCheck (aShapeClass, aDiagramm);
   Ende
   , f_Context.rDiagrammName
  );
 Ende;

 Verfahren TestTmsSerializeController.TestSerialize;
 beginnen
  CreateDiagrammWithShapeAndSaveAndCheck (ShapeClass);
 Ende;

 Funktion TestTmsSerializeControllerPrim.TestSerializeMethodName: String;
 beginnen
  Ergebnis: = 'TestSerialize';
 Ende;

 Verfahren TestTmsSerializeControllerPrim.DeserializeDiargammAndCheck (aÜberprüfen und berichtigen: TmsDiagrammCheck; aShapeClass: RmsShape);
 beginnen
  CreateDiagrammAndCheck (
   Verfahren (aDiagramm: TmsDiagramm)
   beginnen
    TmsSerializeController.DeSerialize (MakeFileName (TestSerializeMethodName, aShapeClass), aDiagramm);
    aÜberprüfen und berichtigen (aDiagramm);
   Ende
   ''
  );
 Ende;

 Verfahren TestTmsSerializeControllerPrim.TestDeSerializeForShapeClass (aShapeClass: RmsShape);
 beginnen
  DeserializeDiargammAndCheck (
   Verfahren (aDiagramm: TmsDiagramm)
   beginnen
    SaveDiagrammAndCheck (aShapeClass, aDiagramm);
   Ende
  , aShapeClass
  );
 Ende;

 Verfahren TestTmsSerializeController.TestDeSerialize;
 beginnen
  TestDeSerializeForShapeClass (ShapeClass);
 Ende;

 Konstruktor TestTmsSerializeControllerPrim.Create (const aContext: TmsShapeTestContext);
 beginnen
  Create (aContext.rMethodName) geerbt;
  f_Context: = aContext;
 Ende;

 Verfahren TestTmsSerializeControllerPrim.TestDeSerializeViaShapeCheckForShapeClass (aShapeClass: RmsShape);
 beginnen
  DeserializeDiargammAndCheck (
   Verfahren (aDiagramm: TmsDiagramm)
   var
    l_Shape: TmsShape;
    l_Index: Integer;
   beginnen
    Überprüfen Sie (aDiagramm.Name = f_Context.rDiagrammName);
    Check (aDiagramm.ShapeList <> nil);
    Überprüfen Sie (aDiagramm.ShapeList.Count = ShapesCount);
    Check (Länge (f_Coords) = aDiagramm.ShapeList.Count);
    für l_Index: = 0 bis Pred (aDiagramm.ShapeList.Count) tun
    beginnen
     l_Shape: = aDiagramm.ShapeList [l_Index] .HackInstance Als TmsShape;
     Überprüfen Sie (l_Shape.ClassType = aShapeClass);
     Überprüfen Sie (l_Shape.StartPoint.X = f_Coords [l_Index] .X);
     Überprüfen Sie (l_Shape.StartPoint.Y = f_Coords [l_Index] .Y);
    Ende; // für l_Shape
   Ende
  , aShapeClass
  );
 Ende;

 Verfahren TestTmsSerializeController.TestDeSerializeViaShapeCheck;
 beginnen
  TestDeSerializeViaShapeCheckForShapeClass (ShapeClass);
 Ende;

 Verfahren TestTmsSerializeControllerPrim.OutToFileAndCheck (aLambda: TmsFileLambda);
 var
  l_FileNameTest: String;
  l_FS: TFileStream;
 beginnen
  l_FileNameTest: = TestResultsFileName (ShapeClass);
  l_FS: = TFileStream.Create (l_FileNameTest, fmCreate);
  versuchen
   aLambda (l_FS);
  schließlich
   FreeAndNil (l_FS);
  Ende; // try..finally
  CheckFileWithEtalon (l_FileNameTest);
 Ende;

 Verfahren TestTmsSerializeController.TestShapeName;
 beginnen
  OutToFileAndCheck (
   Verfahren (aFile: TFileStream)
   beginnen
    aFile.Write (Ansistring (ShapeClass.ClassName) [1], Länge (ShapeClass.ClassName));
   Ende
  );
 Ende;

 Verfahren TestTmsSerializeController.TestDiagrammName;
 beginnen
  OutToFileAndCheck (
   Verfahren (aFile: TFileStream)
   beginnen
    aFile.Write (Ansistring (f_Context.rDiagrammName) [1], Länge (f_Context.rDiagrammName));
   Ende
  );
 Ende;

 Klasse Verfahren TmsShapeTestPrim.CheckShapes (aÜberprüfen und berichtigen: TmsShapeClassCheck);
 beginnen
  TmsRegisteredShapes.IterateShapes (
   Verfahren (aShapeClass: RmsShape)
   beginnen
    wenn nicht aShapeClass.InheritsFrom (TmsMover), dann
     aÜberprüfen und berichtigen (aShapeClass);
   Ende
  );
 Ende;

 Funktion TestTmsSerializeControllerPrim.ShapeClass: RmsShape;
 beginnen
  Ergebnis: = f_Context.rShapeClass;
 Ende;

 Funktion TmsParametrizedShapeTest.TestSerializeMethodName: String;
 beginnen
  Ergebnis: = f_TestSerializeMethodName + TestSerializeMethodName geerbt;
 Ende;

 Konstruktor TmsParametrizedShapeTest.Create (const aContext: TmsShapeTestContext);
 beginnen
  Create (aContext) geerbt;
  FTestName: = f_Context.rShapeClass.ClassName + '.'  + AContext.rMethodName;
  f_TestSerializeMethodName: = f_Context.rShapeClass.ClassName +; '.'
 Ende;

 // TmsParametrizedShapeTestSuite

 Konstruktor TmsParametrizedShapeTestSuite.CreatePrim;
 beginnen
  Create (TmsParametrizedShapeTest) geerbt;
 Ende;

 Klasse Funktion TmsParametrizedShapeTestSuite.Create: ITest;
 beginnen
  Ergebnis: = CreatePrim;
 Ende;

 Verfahren TmsParametrizedShapeTestSuite.AddTests (Testklasse: TTestCaseClass);
 beginnen
  Behaupten (testClass.InheritsFrom (TmsParametrizedShapeTest));

  RandSeed: = 10;
  TmsShapeTestPrim.CheckShapes (
   Verfahren (aShapeClass: RmsShape)
   var
    l_Method: TRttiMethod;
    l_DiagrammName: String;
    l_Seed: Integer;
    l_ShapesCount: Integer;
   beginnen
    l_Seed: = Random (High (l_Seed));
    l_DiagrammName: = 'Diagramm №' + IntToStr (Random (10));
    l_ShapesCount: = Random (1000) + 1;
    für l_Method in TRttiContext.Create.GetType (Testclass) .GetMethods tun
     if (l_Method.Visibility = mvPublished), dann
       AddTest (RmsParametrizedShapeTest (Testklasse) .Create (TmsShapeTestContext.Create (l_Method.Name, l_Seed, l_DiagrammName, l_ShapesCount, aShapeClass)));
   Ende
  );
 Ende;

 Initialisierung
   RegisterTest (TmsParametrizedShapeTestSuite.Create);
 Ende.

#1314. Ссылка. Так интереснее

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

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

unit msmCurrentElementSynchronizeBinding;

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

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

interface

uses
 l3IntfUses
 , msmListToListBinding
 , msmEvents
;

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

implementation

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

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

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

end.


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

unit msmCurrentElementShowAsListBinding;

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

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

interface

uses
 l3IntfUses
 , msmListToListBinding
 , msmEvents
;

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

implementation

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

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

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

end.

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

unit msmViewController;

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

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

interface

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

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

implementation

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

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

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

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

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

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

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

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

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

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

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

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

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

end.

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

unit msmController;

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

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

interface

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

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

implementation

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end.

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

unit msmAddElement;

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

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

interface

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

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

implementation

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

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

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

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

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

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

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

end.

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

unit msmPaste;

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

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

interface

uses
 l3IntfUses
 , msmListLikeOperation
 , msmOperations
;

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

implementation

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

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

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

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

end.


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

unit msmDrawingUseCaseView;

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

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

interface

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

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

implementation

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

type _Instance_R_ = TmsmDrawingUseCaseView;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end.

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

unit msmDrawingUseCase;

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

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

interface

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

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

implementation

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end.


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

unit msmListLikeModel;

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

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

interface

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

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

implementation

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 procedure DoDeleteView;

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

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

 procedure DoDeleteElement;

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

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

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

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

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

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

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

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

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

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

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

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

end.