Что ещё может "наша модель"

Я уже приводил ссылку на чужую статью:
http://www.rsdn.ru/article/patterns/patterns.xml

Там описаны формы, модули и операции.

Также я писал про "логику форм и прецеденты".

Вот тут:
http://18delphi.blogspot.ru/2013/08/mvc.html
http://18delphi.blogspot.ru/2013/08/mvc_8.html

У нас есть ещё одно понятие - "реализация прецедента". Это программная сущность, которая выполняет собой роль контроллера форм входящих в неё. И, как следует из названия - эта сущность нужна для реализации логики пользовательского прецедента, выделенного в требованиях.

Исторически мы их назвали "фабриками сборок форм". Это был "период исканий". И тогда мы ещё не понимали, что это ИМЕННО - "реализации прецедентов". Поэтому в коде много упоминаний FormSetFactory. В коде реализации прецедентов (FormSetFactory) описываются так:

unit fsSituationSearch;

{$Include nsDefine.inc}

interface

uses
  Classes,
  vcmInterfaces,
  
  vcmFormSetFactory,
  
  vcmUserControls,

  QueryCardInterfaces,
  l3StringIDEx,
  PrimSaveLoadUserTypes_slqtKW_UserType,
  PrimAttributeSelect_utSingleSearch_UserType,
  PrimTreeAttributeSelect_astNone_UserType,
  PrimTreeAttributeFirstLevel_flSituation_UserType,
  FiltersUserTypes_utFilters_UserType,
  Common_FormDefinitions_Controls,
  Search_FormDefinitions_Controls,
  PrimSelectedAttributes_utSelectedAttributes_UserType,
  SearchLite_FormDefinitions_Controls,
  vcmFormSetFormsCollectionItemPrim,
  SimpleListInterfaces {a},
  SearchInterfaces {a},
  l3TreeInterfaces,
  vcmFormSetFactoryPrim
  ;

type
  Tfs_SituationSearch = {final fsf} class(TvcmFormSetFactory)
   {* ППС 6.х }
  protected
  // overridden protected methods
   procedure InitFields; override;
   class function GetInstance: TvcmFormSetFactoryPrim; override;
  public
  // public methods
   function SaveLoadParentSlqtKWNeedMakeForm(const aDataSource: IvcmFormSetDataSource;
      out aNew: IvcmFormDataSource;
      aSubUserType: TvcmUserType): Boolean;
     {* Обработчик OnNeedMakeForm для SaveLoad }
   function AttributeSelectParentUtSingleSearchNeedMakeForm(const aDataSource: IvcmFormSetDataSource;
      out aNew: IvcmFormDataSource;
      aSubUserType: TvcmUserType): Boolean;
     {* Обработчик OnNeedMakeForm для AttributeSelect }
   function TreeAttributeSelectParentAstNoneNeedMakeForm(const aDataSource: IvcmFormSetDataSource;
      out aNew: IvcmFormDataSource;
      aSubUserType: TvcmUserType): Boolean;
     {* Обработчик OnNeedMakeForm для TreeAttributeSelect }
   function SelectedAttributesChildUtSelectedAttributesNeedMakeForm(const aDataSource: IvcmFormSetDataSource;
      out aNew: IvcmFormDataSource;
      aSubUserType: TvcmUserType): Boolean;
     {* Обработчик OnNeedMakeForm для SelectedAttributes }
   function FiltersNavigatorUtFiltersNeedMakeForm(const aDataSource: IvcmFormSetDataSource;
      out aNew: IvcmFormDataSource;
      aSubUserType: TvcmUserType): Boolean;
     {* Обработчик OnNeedMakeForm для Filters }
   function TreeAttributeFirstLevelNavigatorFlSituationNeedMakeForm(const aDataSource: IvcmFormSetDataSource;
      out aNew: IvcmFormDataSource;
      aSubUserType: TvcmUserType): Boolean;
     {* Обработчик OnNeedMakeForm для TreeAttributeFirstLevel }
  public
  // singleton factory method
    class function Instance: Tfs_SituationSearch;
     {- возвращает экземпляр синглетона. }
  end;//Tfs_SituationSearch

implementation

uses
  l3Base {a},
  l3MessageID,
  SysUtils {a}
  ;

// start class Tfs_SituationSearch

var g_Tfs_SituationSearch : Tfs_SituationSearch = nil;

procedure Tfs_SituationSearchFree;
begin
 FreeAndNil(g_Tfs_SituationSearch);
end;

class function Tfs_SituationSearch.Instance: Tfs_SituationSearch;
begin
 if (g_Tfs_SituationSearch = nil) then
 begin
  l3System.AddExitProc(Tfs_SituationSearchFree);
  g_Tfs_SituationSearch := Create;
 end;
 Result := g_Tfs_SituationSearch;
end;

var
    { Локализуемые строки SituationSearchCaptionLocalConstants }
   str_fsSituationSearchCaption : Tl3StringIDEx = (rS : -1; rLocalized : false; rKey : 'fsSituationSearchCaption'; rValue : 'ППС 6.х');
    { Заголовок фабрики сборки форм "SituationSearch" }

// start class Tfs_SituationSearch

function Tfs_SituationSearch.SaveLoadParentSlqtKWNeedMakeForm(const aDataSource: IvcmFormSetDataSource;
  out aNew: IvcmFormDataSource;
  aSubUserType: TvcmUserType): Boolean;
var
 l_UseCase : IsdsSituation;
begin
 if Supports(aDataSource, IsdsSituation, l_UseCase) then
  try
   //#UC START# *4D80CC1002D6NeedMake_impl*
   aNew := l_UseCase.dsSaveLoad;
   //#UC END# *4D80CC1002D6NeedMake_impl*
  finally
   l_UseCase := nil;
  end;//try..finally
 Result := (aNew <> nil);
end;//Tfs_SituationSearch.SaveLoadParentSlqtKWNeedMakeForm

function Tfs_SituationSearch.AttributeSelectParentUtSingleSearchNeedMakeForm(const aDataSource: IvcmFormSetDataSource;
  out aNew: IvcmFormDataSource;
  aSubUserType: TvcmUserType): Boolean;
var
 l_UseCase : IsdsSituation;
begin
 if Supports(aDataSource, IsdsSituation, l_UseCase) then
  try
   //#UC START# *4D80CC820003NeedMake_impl*
   aNew := l_UseCase.dsAttributeSelect;
   //#UC END# *4D80CC820003NeedMake_impl*
  finally
   l_UseCase := nil;
  end;//try..finally
 Result := (aNew <> nil);
end;//Tfs_SituationSearch.AttributeSelectParentUtSingleSearchNeedMakeForm

function Tfs_SituationSearch.TreeAttributeSelectParentAstNoneNeedMakeForm(const aDataSource: IvcmFormSetDataSource;
  out aNew: IvcmFormDataSource;
  aSubUserType: TvcmUserType): Boolean;
var
 l_UseCase : IsdsSituation;
begin
 if Supports(aDataSource, IsdsSituation, l_UseCase) then
  try
   //#UC START# *4D80CCDD0117NeedMake_impl*
   aNew := l_UseCase.dsTreeAttributeSelect;
   //#UC END# *4D80CCDD0117NeedMake_impl*
  finally
   l_UseCase := nil;
  end;//try..finally
 Result := (aNew <> nil);
end;//Tfs_SituationSearch.TreeAttributeSelectParentAstNoneNeedMakeForm

function Tfs_SituationSearch.SelectedAttributesChildUtSelectedAttributesNeedMakeForm(const aDataSource: IvcmFormSetDataSource;
  out aNew: IvcmFormDataSource;
  aSubUserType: TvcmUserType): Boolean;
var
 l_UseCase : IsdsSituation;
begin
 if Supports(aDataSource, IsdsSituation, l_UseCase) then
  try
   //#UC START# *4D80CCF40025NeedMake_impl*
   aNew := l_UseCase.dsSelectedAttributes;
   //#UC END# *4D80CCF40025NeedMake_impl*
  finally
   l_UseCase := nil;
  end;//try..finally
 Result := (aNew <> nil);
end;//Tfs_SituationSearch.SelectedAttributesChildUtSelectedAttributesNeedMakeForm

function Tfs_SituationSearch.FiltersNavigatorUtFiltersNeedMakeForm(const aDataSource: IvcmFormSetDataSource;
  out aNew: IvcmFormDataSource;
  aSubUserType: TvcmUserType): Boolean;
var
 l_UseCase : IsdsSituation;
begin
 if Supports(aDataSource, IsdsSituation, l_UseCase) then
  try
   //#UC START# *4D80CC20008BNeedMake_impl*
   aNew := l_UseCase.dsFilters;
   //#UC END# *4D80CC20008BNeedMake_impl*
  finally
   l_UseCase := nil;
  end;//try..finally
 Result := (aNew <> nil);
end;//Tfs_SituationSearch.FiltersNavigatorUtFiltersNeedMakeForm

function Tfs_SituationSearch.TreeAttributeFirstLevelNavigatorFlSituationNeedMakeForm(const aDataSource: IvcmFormSetDataSource;
  out aNew: IvcmFormDataSource;
  aSubUserType: TvcmUserType): Boolean;
var
 l_UseCase : IsdsSituation;
begin
 if Supports(aDataSource, IsdsSituation, l_UseCase) then
  try
   //#UC START# *4D80CC2E03BCNeedMake_impl*
   aNew := l_UseCase.dsTreeAttributeFirstLevel;
   //#UC END# *4D80CC2E03BCNeedMake_impl*
  finally
   l_UseCase := nil;
  end;//try..finally
 Result := (aNew <> nil);
end;//Tfs_SituationSearch.TreeAttributeFirstLevelNavigatorFlSituationNeedMakeForm

procedure Tfs_SituationSearch.InitFields;
 {-}
begin
 inherited;
 with AddZone(vcm_ztParent, fm_cfSaveLoad) do
 begin
  UserType := slqtKW;
  with AddZone(vcm_ztParent, fm_cfAttributeSelect) do
  begin
   UserType := utSingleSearch;
   with AddZone(vcm_ztParent, fm_efTreeAttributeSelect) do
   begin
    UserType := astNone;
    OnNeedMakeForm := TreeAttributeSelectParentAstNoneNeedMakeForm;
   end;
   with AddZone(vcm_ztChild, fm_enSelectedAttributes) do
   begin
    UserType := utSelectedAttributes;
    OnNeedMakeForm := SelectedAttributesChildUtSelectedAttributesNeedMakeForm;
   end;
   OnNeedMakeForm := AttributeSelectParentUtSingleSearchNeedMakeForm;
  end;
  OnNeedMakeForm := SaveLoadParentSlqtKWNeedMakeForm;
 end;
 with AddZone(vcm_ztNavigator, fm_enFilters) do
 begin
  UserType := utFilters;
  OnNeedMakeForm := FiltersNavigatorUtFiltersNeedMakeForm;
 end;
 with AddZone(vcm_ztNavigator, fm_efTreeAttributeFirstLevel) do
 begin
  UserType := flSituation;
  ActivateIfUpdate := wafAlways;
  OnNeedMakeForm := TreeAttributeFirstLevelNavigatorFlSituationNeedMakeForm;
 end;
 Caption := str_fsSituationSearchCaption.AsCStr;
end;//Tfs_SituationSearch.InitFields

class function Tfs_SituationSearch.GetInstance: TvcmFormSetFactoryPrim;
 {-}
begin
 Result := Self.Instance;
end;//Tfs_SituationSearch.GetInstance

initialization
 str_fsSituationSearchCaption.Init;

end.

Методы вида XXXNeedMakeForm служат для определения необходимости создания формы представления и передачи этому представлению его бизнес-объекта (контроллера).

Сразу оговорюсь, что использование Supports - это наследие "времён RAD", когда модель описывалась в дизайнере форм, а не на "чертежах".

Сейчас - есть чёткое понимание - как избежать данного Supports. Но поскольку этого пока не было сделано - привожу код как есть.

Запись вида:
AddZone(vcm_ztParent, fm_cfSaveLoad)
-- служит для связывания формы представления с конкретной зоной главного окна, в которое будет встраиваться реализация прецедента.

Регистрируются в конечном приложении они примерно так:

procedure TAppRes.RegisterFormSetFactories;
begin
 inherited;
 RegisterFormSetFactory(Tfs_CompareEditions);
 RegisterFormSetFactory(Tfs_InternetAgent);
 RegisterFormSetFactory(Tfs_Folders);
 RegisterFormSetFactory(Tfs_Autoreferat);
 RegisterFormSetFactory(Tfs_AutoreferatAfterSearch);
 RegisterFormSetFactory(Tfs_Document);
 RegisterFormSetFactory(Tfs_DocumentWithFlash);
 RegisterFormSetFactory(Tfs_List);
 RegisterFormSetFactory(Tfs_Diction);
 RegisterFormSetFactory(Tfs_Tips);
 RegisterFormSetFactory(Tfs_MedicDiction);
 RegisterFormSetFactory(Tfs_MedicFirmDocument);
 RegisterFormSetFactory(Tfs_DrugDocument);
 RegisterFormSetFactory(Tfs_DrugList);
 RegisterFormSetFactory(Tfs_MedicFirmList);
 RegisterFormSetFactory(Tfs_SendConsultation);
 RegisterFormSetFactory(Tfs_Consultation);
 RegisterFormSetFactory(Tfs_ViewChangedFragments);
 RegisterFormSetFactory(Tfs_SituationSearch);
 RegisterFormSetFactory(Tfs_SituationFilter);
 RegisterFormSetFactory(Tfs_AACContents);
 RegisterFormSetFactory(Tfs_AAC);
end;

-- понятное дело, что правильнее было сделать внедрение зависимостей (http://ru.wikipedia.org/wiki/%D0%92%D0%BD%D0%B5%D0%B4%D1%80%D0%B5%D0%BD%D0%B8%D0%B5_%D0%B7%D0%B0%D0%B2%D0%B8%D1%81%D0%B8%D0%BC%D0%BE%D1%81%D1%82%D0%B8). Но оно - пока сделано не было.

 Создаётся же экземпляр реализации прецедента таким образом:

class procedure TSearchModule.OpenSituationCard(const aQuery: IQuery);
var
 __WasEnter : Boolean;
//#UC START# *4F27EA7D0011_4AA641A3036C_var*
//#UC END# *4F27EA7D0011_4AA641A3036C_var*
begin
 __WasEnter := vcmEnterFactory;
 try
  //#UC START# *4F27EA7D0011_4AA641A3036C_impl*
   Tfs_SituationSearch.Make(TsdsSituation.Make(TdeSearch.Make(nsCStr(AT_KW), aQuery)));
  //#UC END# *4F27EA7D0011_4AA641A3036C_impl*
 finally
  if __WasEnter then
   vcmLeaveFactory;
 end;//try..finally
end;//TSearchModule.OpenSituationCard

Tfs_SituationSearch.Make - это фабричный метод, который создаёт экземпляр "реализации прецедента" и встраивает его в главную форму приложения, заменяя им предыдущую активную "реализацию прецедента".

При этом сохранение состояния всех составляющих предыдущей реализации прецедента в историю Back/Forward осуществляется "автоматически".

TsdsSituation.Make - фабричный метод, создающий бизнес-объект логики прецедента. Который является контроллером для бизнес-объектов форм.

aQuery - это источник данных из предметной области для инициализации данного прецедента. В данном случае это IQuery - т.е. пользовательский запрос. Например загруженный из папок.

В конечном итоге метод OpenSituationCard зовётся примерно так:

class procedure TAppRes.OpenQuery(aQueryType: TlgQueryType;
  const aQuery: IQuery);
//#UC START# *4AC4A69D03B7_4A925AFF01BA_var*
//#UC END# *4AC4A69D03B7_4A925AFF01BA_var*
begin
//#UC START# *4AC4A69D03B7_4A925AFF01BA_impl*
 case aQueryType of
  lg_qtKeyWord:
   TdmStdRes.OpenSituationCard(aQuery);
  lg_qtAttribute:
   TdmStdRes.AttributeSearch(aQuery, nil);
  lg_qtPublishedSource:
   TdmStdRes.PublishSourceSearch(aQuery, nil);
  lg_qtLegislationReview:
   TdmStdRes.OpenLegislationReview(aQuery);
  lg_qtSendConsultation:
   vcmDispatcher.ModuleOperation(TdmStdRes.mod_opcode_Search_OpenConsult);
  lg_qtBaseSearch:
   TdmStdRes.OpenBaseSearch(ns_bsokGlobal,
                            aQuery);
  lg_qtInpharmSearch:
   TdmStdRes.InpharmSearch(aQuery, nil);
  else
   inherited;   
 end;//case aQueryType
//#UC END# *4AC4A69D03B7_4A925AFF01BA_impl*
end;//TPrimNemesisRes.OpenQuery

А уж OpenQuery, зовётся из "клиентского кода" так:

procedure TPrimMainMenuNewForm.SearchClick(aSender: TObject);
//#UC START# *4ACB8B7B0192_4958E1F700C0_var*
//#UC END# *4ACB8B7B0192_4958E1F700C0_var*
begin
//#UC START# *4ACB8B7B0192_4958E1F700C0_impl*
 if (aSender = flAttributeSearch) then
  TdmStdRes.OpenQuery(lg_qtAttribute, nil)
 else
 if (aSender = flSitiationSearch) then
  TdmStdRes.OpenQuery(lg_qtKeyWord, nil)
 else
 if (aSender = flPublishedSourceSearch) then
  TdmStdRes.OpenQuery(lg_qtPublishedSource, nil)
 else
 if (aSender = flDictionSearch) then
  TdmStdRes.OpenDictionary(nil, NativeMainForm)
 else
  Assert(false);
//#UC END# *4ACB8B7B0192_4958E1F700C0_impl*
end;//TPrimMainMenuNewForm.SearchClick

-- из обработчика OnClick различных контролов.

Или так:

procedure TPrimWorkJournalForm.SavedQuery_Execute_Execute(const aParams: IvcmExecuteParamsPrim);
//#UC START# *4C3F342E02AF_4BD6D6EA0075exec_var*
var
 l_AdapterNode : INodeBase;
 l_BaseEntity : IUnknown;
//#UC END# *4C3F342E02AF_4BD6D6EA0075exec_var*
begin
//#UC START# *4C3F342E02AF_4BD6D6EA0075exec_impl*
 if Supports(JournalTree.TreeView.CurrentNode, INodeBase, l_AdapterNode) then
  try
   try
    l_AdapterNode.GetEntity(l_BaseEntity);
   except
    on ECanNotFindData do
     Exit; //TODO: нода "пропала" что делать?
   end;
   try
    TdmStdRes.OpenQuery(l_BaseEntity As IQuery);
   finally
    l_BaseEntity := nil;
   end;//try..finally
  finally
   l_AdapterNode := nil;
  end;//try..finally
//#UC END# *4C3F342E02AF_4BD6D6EA0075exec_impl*
end;//TPrimWorkJournalForm.SavedQuery_ExecuteQuery_Execute

-- из обработчика "операции" SavedQuery.Execute на одной из форм представления другого прецедента.

Не скрою. Выглядит вся эта "конструкция" - тяжеловесно. Особенно на ПЕРВЫЙ ВЗГЛЯД.

Но во-первых - всё это рождалось годами. В процессе множества дискуссий и недопониманий.

Во-вторых - очень долго нам мешало то, что мы пытались всё это делать "через призму RAD" и дизайнеров форм и компонентов. Пока не пришли к пониманию того, что мета-модель и "чертежи" - годятся для этого гораздо лучше.

В-третьих - было допущено множество архитектурных ошибок. Опять же продиктованных "периодом исканий". Какие-то ошибки были исправлены, какие-то - до сих пор существуют. Но зато есть понимание - как их исправлять. И какой должна быть "идеальная архитектура.

Зато ТЕПЕРЬ, при наличии мета-модели, "чертежей" и кодогенерации - мы реально можем можем собирать реализации конкретных пользовательских прецедентов и их логики из УЖЕ существующих "кирпичиков" на модели и "номенклатуры микросхем".

Процесс создания НОВЫХ прецедентов выглядит реально как "отвёрточная сборка". Разумеется до тех пор, пока готовые "кирпичики" удовлетворяют текущим потребностям. Новые "кирпичики" делать сложнее, но тоже - не "космически" сложно. И для этого тоже существует поддержка со стороны мета-модели.