Я уже приводил ссылку на чужую статью:
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" и дизайнеров форм и компонентов. Пока не пришли к пониманию того, что мета-модель и "чертежи" - годятся для этого гораздо лучше.
В-третьих - было допущено множество архитектурных ошибок. Опять же продиктованных "периодом исканий". Какие-то ошибки были исправлены, какие-то - до сих пор существуют. Но зато есть
понимание - как их исправлять. И какой должна быть "идеальная архитектура.
Зато ТЕПЕРЬ, при наличии мета-модели, "чертежей" и кодогенерации - мы реально можем можем собирать реализации конкретных пользовательских прецедентов и их логики из УЖЕ существующих "кирпичиков" на модели и "номенклатуры микросхем".
Процесс создания НОВЫХ прецедентов выглядит реально как "отвёрточная сборка". Разумеется до тех пор, пока готовые "кирпичики" удовлетворяют текущим потребностям. Новые "кирпичики" делать сложнее, но тоже - не "космически" сложно. И для этого тоже существует поддержка со стороны мета-модели.
