Ещё "о контейнерах"

Пост был тут - http://18delphi.blogspot.ru/2013/09/templates-in-object-pascal.html

И мой комментарий - "Поверьте - я ДАВНО смотрел на stl и ДУМАЛ - "как его написать для Delphi" и когда я прочитал статью Акжана Абдуллина - я "понял КАК"."

МОЙ товарищ мне написал следующее - Печально, что в Delphi приходится задумываться о таком, а не выбирать из готовых реализаций и задумываться уже о решении бизнес задач.

Я ему ответил - Дим, прости, но по-моему - ты меня - "троллишь"  а жаль... Я твоё мнение - уважаю...


Он продолжил - Почему троллю? Просто в упор не могу понять как почти в 2014 году какой-то язык программирования еще может всерьез заставлять решать подобные задачи не в образовательных целях?  Причем язык именно для прикладных задач.

Посему я написал ответ, которым захотелось поделиться.

Вот он:

"по-моему ты меня всё же не понял :-( Неужто ты думаешь, что КОНЕЧНАЯ цель состоит в том, чтобы "написать stl"? ВЕРЮ, что ты так не думаешь :-) Просто stl содержит ТАКОЕ количество методов и подходов, которые ХОРОШИ и УДИВИТЕЛЬНЫ. И которые НАДО ИСПОЛЬЗОВАТЬ. Речь-то только об этом. Да и что ни говори - "контейнеры" это хорошее поле для "примеров" АРХИТЕКТУРЫ, КОДА и ТЕСТОВ. Из "контейнеров" в КОНЕЧНОМ итоге складывается ВСЁ ОСТАЛЬНОЕ. Вспомни Вирта - "алгоритмы и СТРУКТУРЫ ДАННЫХ". Речь том о том КАК решать ПРИКЛАДНЫЕ задачи используя ХОРОШИЕ подходы. Тот же Dependency Injection - НЕВОЗМОЖНО (ИМХО) понять - не написав "хотя бы раз в жизни" - подобное. Так понятнее? :-) Я бы мог написать "как устроен например Гарант" (да и ЛЮБОЕ другое большое приложение), только ведь получится - "за деревьями леса не видать". ОЧЕНЬ БОЛЬШАЯ "матрёшка". Посему приходится писать "итеративно". Из "маленьких кубиков"."

Это "не спор ради спора". Это попытки найти "методологию" объяснения СЛОЖНЫХ вещей "простыми словами".

Ещё раз. Ели я приведу пример РЕАЛЬНОГО КОДА из РЕАЛЬНО РАБОТАЮЩЕГО сложного проекта, то его - ВРЯД ЛИ кто-то поймёт. Для понимания ВАЖНА специфика, предметная область, детали, исторические перспективы.

Ну а "контейнеры" - более-менее "всем" понятны. Именно ПОЭТОМУ я столько пишу про "контейнеры". И тесты про контейнеры писал и сами контейнеры. Чтобы ПОДХОДЫ проиллюстрировать. Те же шаблонные типы или "частичное инстанцирование".

Кстати вот хорошая ссылка - http://habrahabr.ru/post/179137/

Я бы рассказал про "аспекты" в нашем приложении, но это же уж ОЧЕНЬ большой бекграунд надо вытащить.

Ну и на закуску.

Про аспекты и примеси.

Для "ценителей".

Голый код:

{$IfNDef HyperlinkToDocumentProducer_imp}

{$Define HyperlinkToDocumentProducer_imp}
 _HyperlinkToDocumentProducer_ = {abstract form} class(_HyperlinkToDocumentProducer_Parent_)
  {* Изготовитель ссылок на документы }
 protected
  procedure InitEntities; override;
 protected
 // property methods
   function pm_GetHyperlinkDocID: Integer; virtual; abstract;
   function pm_GetHyperlinkDocumentName: Il3CString; virtual; abstract;
   function pm_GetHyperlinkSubID: Integer; virtual;
 protected
 // realized methods
   procedure File_MakeHyperlinkToDocument_Test(const aParams: IvcmTestParamsPrim);
     {* Создать ссылку на документ }
   procedure File_MakeHyperlinkToDocument_Execute(const aParams: IvcmExecuteParamsPrim);
     {* Создать ссылку на документ }
   procedure Text_MakeHyperlinkToDocument_Test(const aParams: IvcmTestParamsPrim);
     {* Создать ссылку на документ }
   procedure Text_MakeHyperlinkToDocument_Execute(const aParams: IvcmExecuteParamsPrim);
     {* Создать ссылку на документ }
   procedure Document_MakeHyperlinkToDocument_Test(const aParams: IvcmTestParamsPrim);
     {* Создать ссылку на документ }
   procedure Document_MakeHyperlinkToDocument_Execute(const aParams: IvcmExecuteParamsPrim);
     {* Создать ссылку на документ }
 protected
 // protected properties
   property HyperlinkDocID: Integer
     read pm_GetHyperlinkDocID;
     {* Идентификато документа на который надо ставить ссылку }
   property HyperlinkDocumentName: Il3CString
     read pm_GetHyperlinkDocumentName;
     {* Имя документа на который надо ставить ссылку }
   property HyperlinkSubID: Integer
     read pm_GetHyperlinkSubID;
 end;//_HyperlinkToDocumentProducer_

{$Else HyperlinkToDocumentProducer_imp}

// start class _HyperlinkToDocumentProducer_

function _HyperlinkToDocumentProducer_.pm_GetHyperlinkSubID: Integer;
//#UC START# *4CE41B300315_4CDD18E80034get_var*
//#UC END# *4CE41B300315_4CDD18E80034get_var*
begin
//#UC START# *4CE41B300315_4CDD18E80034get_impl*
 Result := 0;
//#UC END# *4CE41B300315_4CDD18E80034get_impl*
end;//_HyperlinkToDocumentProducer_.pm_GetHyperlinkSubID

procedure _HyperlinkToDocumentProducer_.File_MakeHyperlinkToDocument_Test(const aParams: IvcmTestParamsPrim);
//#UC START# *4CDD18A20143_4CDD18E80034test_var*
//#UC END# *4CDD18A20143_4CDD18E80034test_var*
begin
//#UC START# *4CDD18A20143_4CDD18E80034test_impl*
 aParams.Op.Flag[vcm_ofEnabled] := (HyperlinkDocID > 0) AND not l3IsNil(HyperlinkDocumentName);
//#UC END# *4CDD18A20143_4CDD18E80034test_impl*
end;//_HyperlinkToDocumentProducer_.File_MakeHyperlinkToDocument_Test

procedure _HyperlinkToDocumentProducer_.File_MakeHyperlinkToDocument_Execute(const aParams: IvcmExecuteParamsPrim);
//#UC START# *4CDD18A20143_4CDD18E80034exec_var*
//#UC END# *4CDD18A20143_4CDD18E80034exec_var*
begin
//#UC START# *4CDD18A20143_4CDD18E80034exec_impl*
 l3System.SetClipboardData(
  TevConstStringData.Make(
   TevdHyperlinkInfo.Make(HyperlinkDocumentName,
                          TevAddress_C(HyperlinkDocID, HyperlinkSubID){$IfDef XE4}.rTafwAddress{$EndIf},
                          str_HyperlinkToDocumentProducerAppInfo.AsCStr),
                          nil));
 Say(inf_HyperlinkToDocumentProducerLinkMade);                         
//#UC END# *4CDD18A20143_4CDD18E80034exec_impl*
end;//_HyperlinkToDocumentProducer_.File_MakeHyperlinkToDocument_Execute

procedure _HyperlinkToDocumentProducer_.Text_MakeHyperlinkToDocument_Test(const aParams: IvcmTestParamsPrim);
//#UC START# *4CDD5C3901E0_4CDD18E80034test_var*
//#UC END# *4CDD5C3901E0_4CDD18E80034test_var*
begin
//#UC START# *4CDD5C3901E0_4CDD18E80034test_impl*
 File_MakeHyperlinkToDocument_Test(aParams);
//#UC END# *4CDD5C3901E0_4CDD18E80034test_impl*
end;//_HyperlinkToDocumentProducer_.Text_MakeHyperlinkToDocument_Test

procedure _HyperlinkToDocumentProducer_.Text_MakeHyperlinkToDocument_Execute(const aParams: IvcmExecuteParamsPrim);
//#UC START# *4CDD5C3901E0_4CDD18E80034exec_var*
//#UC END# *4CDD5C3901E0_4CDD18E80034exec_var*
begin
//#UC START# *4CDD5C3901E0_4CDD18E80034exec_impl*
 File_MakeHyperlinkToDocument_Execute(aParams);
//#UC END# *4CDD5C3901E0_4CDD18E80034exec_impl*
end;//_HyperlinkToDocumentProducer_.Text_MakeHyperlinkToDocument_Execute

procedure _HyperlinkToDocumentProducer_.Document_MakeHyperlinkToDocument_Test(const aParams: IvcmTestParamsPrim);
//#UC START# *4CDE7C2C0258_4CDD18E80034test_var*
//#UC END# *4CDE7C2C0258_4CDD18E80034test_var*
begin
//#UC START# *4CDE7C2C0258_4CDD18E80034test_impl*
 File_MakeHyperlinkToDocument_Test(aParams);
//#UC END# *4CDE7C2C0258_4CDD18E80034test_impl*
end;//_HyperlinkToDocumentProducer_.Document_MakeHyperlinkToDocument_Test

procedure _HyperlinkToDocumentProducer_.Document_MakeHyperlinkToDocument_Execute(const aParams: IvcmExecuteParamsPrim);
//#UC START# *4CDE7C2C0258_4CDD18E80034exec_var*
//#UC END# *4CDE7C2C0258_4CDD18E80034exec_var*
begin
//#UC START# *4CDE7C2C0258_4CDD18E80034exec_impl*
 File_MakeHyperlinkToDocument_Execute(aParams);
//#UC END# *4CDE7C2C0258_4CDD18E80034exec_impl*
end;//_HyperlinkToDocumentProducer_.Document_MakeHyperlinkToDocument_Execute

procedure _HyperlinkToDocumentProducer_.InitEntities;
begin
 inherited;
 with Entities.Entities do
 begin
  PublishFormEntity(en_File, nil);
  PublishFormEntity(en_Text, nil);
  PublishFormEntity(en_Document, nil);
  PublishOp(en_File, op_MakeHyperlinkToDocument, File_MakeHyperlinkToDocument_Execute, File_MakeHyperlinkToDocument_Test, nil);
  ShowInContextMenu(en_File, op_MakeHyperlinkToDocument, false);
  ShowInToolbar(en_File, op_MakeHyperlinkToDocument, false);
  PublishOp(en_Text, op_MakeHyperlinkToDocument, Text_MakeHyperlinkToDocument_Execute, Text_MakeHyperlinkToDocument_Test, nil);
  ShowInContextMenu(en_Text, op_MakeHyperlinkToDocument, true);
  ShowInToolbar(en_Text, op_MakeHyperlinkToDocument, false);
  PublishOp(en_Document, op_MakeHyperlinkToDocument, Document_MakeHyperlinkToDocument_Execute, Document_MakeHyperlinkToDocument_Test, nil);
  ShowInContextMenu(en_Document, op_MakeHyperlinkToDocument, true);
  ShowInToolbar(en_Document, op_MakeHyperlinkToDocument, false);
 end;//with Entities.Entities
end;

{$EndIf HyperlinkToDocumentProducer_imp}

{$IfNDef deDocInfoProvider_imp}

{$Define deDocInfoProvider_imp}
 _deDocInfoProvider_ = {mixin} class(_deDocInfoProvider_Parent_)
 protected
 // realized methods
   {$If not defined(Admin) AND not defined(Monitorings)}
   function pm_GetDocInfo: IdeDocInfo;
   {$IfEnd} //not Admin AND not Monitorings
 protected
 // protected methods
   function DocumentForDocInfoProvider: IDocument; virtual; abstract;
 end;//_deDocInfoProvider_

{$Else deDocInfoProvider_imp}

// start class _deDocInfoProvider_

{$If not defined(Admin) AND not defined(Monitorings)}
function _deDocInfoProvider_.pm_GetDocInfo: IdeDocInfo;
//#UC START# *4DF9D63B0360_4F54899502EAget_var*
//#UC END# *4DF9D63B0360_4F54899502EAget_var*
begin
//#UC START# *4DF9D63B0360_4F54899502EAget_impl*
 Result := TdeDocInfo.Make(DocumentForDocInfoProvider);
//#UC END# *4DF9D63B0360_4F54899502EAget_impl*
end;//_deDocInfoProvider_.pm_GetDocInfo
{$IfEnd} //not Admin AND not Monitorings

{$EndIf deDocInfoProvider_imp}

{$IfNDef ucpHAFMacroReplacerFactory_imp}

{$Define ucpHAFMacroReplacerFactory_imp}
 _deDocInfoProvider_Parent_ = _ucpHAFMacroReplacerFactory_Parent_;
 {$Include ..\Presentation\deDocInfoProvider.imp.pas}
 _ucpHAFMacroReplacerFactory_ = {mixin} class(_deDocInfoProvider_ {$If not defined(Admin) AND not defined(Monitorings)}, IucpHAFMacroReplacerFactory{$IfEnd} //not Admin AND not Monitorings
 )
 protected
 // realized methods
   {$If not defined(Admin) AND not defined(Monitorings)}
   function MakeHAFMacroReplacer: IafwHAFMacroReplacer;
   {$IfEnd} //not Admin AND not Monitorings
 end;//_ucpHAFMacroReplacerFactory_

{$Else ucpHAFMacroReplacerFactory_imp}

{$Include ..\Presentation\deDocInfoProvider.imp.pas}

// start class _ucpHAFMacroReplacerFactory_

{$If not defined(Admin) AND not defined(Monitorings)}
function _ucpHAFMacroReplacerFactory_.MakeHAFMacroReplacer: IafwHAFMacroReplacer;
//#UC START# *4AE56DE80093_4F546FD3028F_var*
//#UC END# *4AE56DE80093_4F546FD3028F_var*
begin
//#UC START# *4AE56DE80093_4F546FD3028F_impl*
 Result := TnsDocInfoHAFMacroReplacer.Make(nil, Self.pm_GetDocInfo);
//#UC END# *4AE56DE80093_4F546FD3028F_impl*
end;//_ucpHAFMacroReplacerFactory_.MakeHAFMacroReplacer
{$IfEnd} //not Admin AND not Monitorings

{$EndIf ucpHAFMacroReplacerFactory_imp}

{$IfNDef Printable_imp}

{$Define Printable_imp}
 _Printable_ = {abstract form} class(_Printable_Parent_)
  {* Форма с поддержкой печати. [$234366957] }
 protected
  procedure InitEntities; override;
 protected
 // property methods
   function pm_GetPreview: IafwDocumentPreview; virtual; abstract;
 protected
 // realized methods
   procedure File_Print_Test(const aParams: IvcmTestParamsPrim);
     {* Печать }
   procedure File_Print_Execute(const aParams: IvcmExecuteParamsPrim);
     {* Печать }
   procedure File_PrintDialog_Test(const aParams: IvcmTestParamsPrim);
     {* Печать... }
   procedure File_PrintDialog_Execute(const aParams: IvcmExecuteParamsPrim);
     {* Печать... }
   procedure File_PrintPreview_Test(const aParams: IvcmTestParamsPrim);
     {* Предварительный просмотр }
   procedure File_PrintPreview_Execute(const aParams: IvcmExecuteParamsPrim);
     {* Предварительный просмотр }
 protected
 // protected methods
   function CanPrint: Boolean;
   function GetCanPrint: Boolean; virtual;
   procedure DoPrintExecute(const aParams: IvcmExecuteParamsPrim); virtual;
   procedure DoPreviewExecute(const aParams: IvcmExecuteParamsPrim); virtual;
 protected
 // protected properties
   property Preview: IafwDocumentPreview
     read pm_GetPreview;
 end;//_Printable_

{$Else Printable_imp}

// start class _Printable_

function _Printable_.CanPrint: Boolean;
//#UC START# *4CDAC581005C_4CDABAD0032E_var*
//#UC END# *4CDAC581005C_4CDABAD0032E_var*
begin
//#UC START# *4CDAC581005C_4CDABAD0032E_impl*
 Result := (afw.Application <> nil) AND
           (afw.Application.PrintManager <> nil) AND
           afw.Application.PrintManager.CanPrint AND
           Self.GetCanPrint;
//#UC END# *4CDAC581005C_4CDABAD0032E_impl*
end;//_Printable_.CanPrint

function _Printable_.GetCanPrint: Boolean;
//#UC START# *4CDAC59301AC_4CDABAD0032E_var*
//#UC END# *4CDAC59301AC_4CDABAD0032E_var*
begin
//#UC START# *4CDAC59301AC_4CDABAD0032E_impl*
 Result := true;
//#UC END# *4CDAC59301AC_4CDABAD0032E_impl*
end;//_Printable_.GetCanPrint

procedure _Printable_.DoPrintExecute(const aParams: IvcmExecuteParamsPrim);
//#UC START# *51A45199015E_4CDABAD0032E_var*
var
 l_Preview : IafwDocumentPreview;
//#UC END# *51A45199015E_4CDABAD0032E_var*
begin
//#UC START# *51A45199015E_4CDABAD0032E_impl*
 l_Preview := Preview;
 if (l_Preview <> nil) then
  l_Preview.Print;
//#UC END# *51A45199015E_4CDABAD0032E_impl*
end;//_Printable_.DoPrintExecute

procedure _Printable_.DoPreviewExecute(const aParams: IvcmExecuteParamsPrim);
//#UC START# *51A451E20376_4CDABAD0032E_var*
var
 l_Preview : IafwDocumentPreview;
//#UC END# *51A451E20376_4CDABAD0032E_var*
begin
//#UC START# *51A451E20376_4CDABAD0032E_impl*
 l_Preview := Preview;
 if (l_Preview <> nil) then
  TdmStdRes.MakePreview(l_Preview);
//#UC END# *51A451E20376_4CDABAD0032E_impl*
end;//_Printable_.DoPreviewExecute

procedure _Printable_.File_Print_Test(const aParams: IvcmTestParamsPrim);
//#UC START# *49521D8E0295_4CDABAD0032Etest_var*
//#UC END# *49521D8E0295_4CDABAD0032Etest_var*
begin
//#UC START# *49521D8E0295_4CDABAD0032Etest_impl*
 aParams.Op.Flag[vcm_ofEnabled] := Self.CanPrint;
//#UC END# *49521D8E0295_4CDABAD0032Etest_impl*
end;//_Printable_.File_Print_Test

procedure _Printable_.File_Print_Execute(const aParams: IvcmExecuteParamsPrim);
//#UC START# *49521D8E0295_4CDABAD0032Eexec_var*
//#UC END# *49521D8E0295_4CDABAD0032Eexec_var*
begin
//#UC START# *49521D8E0295_4CDABAD0032Eexec_impl*
 DoPrintExecute(aParams);
//#UC END# *49521D8E0295_4CDABAD0032Eexec_impl*
end;//_Printable_.File_Print_Execute

procedure _Printable_.File_PrintDialog_Test(const aParams: IvcmTestParamsPrim);
//#UC START# *495220DE0298_4CDABAD0032Etest_var*
//#UC END# *495220DE0298_4CDABAD0032Etest_var*
begin
//#UC START# *495220DE0298_4CDABAD0032Etest_impl*
 aParams.Op.Flag[vcm_ofEnabled] := Self.CanPrint;
//#UC END# *495220DE0298_4CDABAD0032Etest_impl*
end;//_Printable_.File_PrintDialog_Test

procedure _Printable_.File_PrintDialog_Execute(const aParams: IvcmExecuteParamsPrim);
//#UC START# *495220DE0298_4CDABAD0032Eexec_var*
var
 l_Preview : IafwDocumentPreview;
//#UC END# *495220DE0298_4CDABAD0032Eexec_var*
begin
//#UC START# *495220DE0298_4CDABAD0032Eexec_impl*
 l_Preview := Preview;
 if (l_Preview <> nil) then
  afw.Application.PrintManager.PrintDialog(l_Preview);
//#UC END# *495220DE0298_4CDABAD0032Eexec_impl*
end;//_Printable_.File_PrintDialog_Execute

procedure _Printable_.File_PrintPreview_Test(const aParams: IvcmTestParamsPrim);
//#UC START# *495220F2033A_4CDABAD0032Etest_var*
//#UC END# *495220F2033A_4CDABAD0032Etest_var*
begin
//#UC START# *495220F2033A_4CDABAD0032Etest_impl*
 aParams.Op.Flag[vcm_ofEnabled] := Self.CanPrint;
//#UC END# *495220F2033A_4CDABAD0032Etest_impl*
end;//_Printable_.File_PrintPreview_Test

procedure _Printable_.File_PrintPreview_Execute(const aParams: IvcmExecuteParamsPrim);
//#UC START# *495220F2033A_4CDABAD0032Eexec_var*
//#UC END# *495220F2033A_4CDABAD0032Eexec_var*
begin
//#UC START# *495220F2033A_4CDABAD0032Eexec_impl*
 DoPreviewExecute(aParams);
//#UC END# *495220F2033A_4CDABAD0032Eexec_impl*
end;//_Printable_.File_PrintPreview_Execute

procedure _Printable_.InitEntities;
begin
 inherited;
 with Entities.Entities do
 begin
  PublishFormEntity(en_File, nil);
  PublishOp(en_File, op_Print, File_Print_Execute, File_Print_Test, nil);
  PublishOp(en_File, op_PrintDialog, File_PrintDialog_Execute, File_PrintDialog_Test, nil);
  PublishOp(en_File, op_PrintPreview, File_PrintPreview_Execute, File_PrintPreview_Test, nil);
 end;//with Entities.Entities
end;

{$EndIf Printable_imp}

{$IfNDef PrintableBitmap_imp}

{$Define PrintableBitmap_imp}
 Graphics_Bitmap = Graphics.TBitmap;
  {* Переопределение TBitmap, чтобы не нарваться на конфликт с Windows.TBitmap }

 _Printable_Parent_ = _PrintableBitmap_Parent_;
 {$Include ..\Printing\Printable.imp.pas}
 _PrintableBitmap_ = {abstract form} class(_Printable_)
 protected
 // property methods
   function pm_GetBitmapForPrint: Graphics_Bitmap; virtual; abstract;
 protected
 // realized methods
   function pm_GetPreview: IafwDocumentPreview; override;
 protected
 // protected methods
   function Name: Il3CString; virtual; abstract;
   function ShortName: Il3CString; virtual; abstract;
   function DPI: Integer; virtual;
 protected
 // protected properties
   property BitmapForPrint: Graphics_Bitmap
     read pm_GetBitmapForPrint;
 end;//_PrintableBitmap_

{$Else PrintableBitmap_imp}

{$Include ..\Printing\Printable.imp.pas}

// start class _PrintableBitmap_

function _PrintableBitmap_.DPI: Integer;
//#UC START# *4CDAE15C035B_4CDACCDF0368_var*
//#UC END# *4CDAE15C035B_4CDACCDF0368_var*
begin
//#UC START# *4CDAE15C035B_4CDACCDF0368_impl*
 Result := 0;
//#UC END# *4CDAE15C035B_4CDACCDF0368_impl*
end;//_PrintableBitmap_.DPI

function _PrintableBitmap_.pm_GetPreview: IafwDocumentPreview;
//#UC START# *4CDAC5E902FF_4CDACCDF0368get_var*
//#UC END# *4CDAC5E902FF_4CDACCDF0368get_var*
begin
//#UC START# *4CDAC5E902FF_4CDACCDF0368get_impl*
 Result := TnsObjectPreview.Make(TevBitmapDataObject.Make(BitmapForPrint, Self.DPI),
                                 evDefaultPreviewCacheKey,
                                 TnsHAFPainter.Make(TnsFixedHAFMacroReplacer.Make(nil, ShortName, Name)));
//#UC END# *4CDAC5E902FF_4CDACCDF0368get_impl*
end;//_PrintableBitmap_.pm_GetPreview

{$EndIf PrintableBitmap_imp}

{$IfNDef PrintableFlash_imp}

{$Define PrintableFlash_imp}
 _PrintableBitmap_Parent_ = _PrintableFlash_Parent_;
 {$Include ..\Printing\PrintableBitmap.imp.pas}
 _PrintableFlash_ = {abstract form} class(_PrintableBitmap_)
  {* Печать флеш-схем. [RequestLink:228689255] }
 private
 // private fields
   f_Bitmap : Tl3Bitmap;
 protected
 // property methods
   function pm_GetFlashForPrint: TvtShockwaveFlashEx; virtual; abstract;
 protected
 // realized methods
   function pm_GetBitmapForPrint: Graphics_Bitmap; override;
 protected
 // overridden protected methods
   procedure Cleanup; override;
     {* Функция очистки полей объекта. }
   function DPI: Integer; override;
 protected
 // protected properties
   property FlashForPrint: TvtShockwaveFlashEx
     read pm_GetFlashForPrint;
 end;//_PrintableFlash_

{$Else PrintableFlash_imp}

{$Include ..\Printing\PrintableBitmap.imp.pas}

// start class _PrintableFlash_

function _PrintableFlash_.pm_GetBitmapForPrint: Graphics_Bitmap;
//#UC START# *4CDACD8302DD_4CDABB1C0025get_var*
var
 l_Flash : TvtShockwaveFlashEx;
 l_DC    : hDC;
//#UC END# *4CDACD8302DD_4CDABB1C0025get_var*
begin
//#UC START# *4CDACD8302DD_4CDABB1C0025get_impl*
 if (f_Bitmap = nil) then
 begin
  f_Bitmap := Tl3Bitmap.Create;
  f_Bitmap.PixelFormat := pf24bit;
 end;//f_Bitmap = nil
 l_Flash := FlashForPrint;
 f_Bitmap.Width := l_Flash.Width;
 f_Bitmap.Height := l_Flash.Height;
 l_DC := f_Bitmap.Canvas.Handle;
 SendMessage(l_Flash.Handle, WM_Paint, WParam(l_DC), 0);
 Assert(l_Flash <> nil);
 Result := f_Bitmap;
//#UC END# *4CDACD8302DD_4CDABB1C0025get_impl*
end;//_PrintableFlash_.pm_GetBitmapForPrint

procedure _PrintableFlash_.Cleanup;
//#UC START# *479731C50290_4CDABB1C0025_var*
//#UC END# *479731C50290_4CDABB1C0025_var*
begin
//#UC START# *479731C50290_4CDABB1C0025_impl*
 FreeAndNil(f_Bitmap);
 inherited;
//#UC END# *479731C50290_4CDABB1C0025_impl*
end;//_PrintableFlash_.Cleanup

function _PrintableFlash_.DPI: Integer;
//#UC START# *4CDAE15C035B_4CDABB1C0025_var*
//#UC END# *4CDAE15C035B_4CDABB1C0025_var*
begin
//#UC START# *4CDAE15C035B_4CDABB1C0025_impl*
 Result := 20;
//#UC END# *4CDAE15C035B_4CDABB1C0025_impl*
end;//_PrintableFlash_.DPI

{$EndIf PrintableFlash_imp}

unit nsWebBrowser;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "View"
// Автор: Люлин А.В.
// Начат: 20.04.2009 22:04
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: <guicontrol::class> F1 Встроенные продукты::InternetAgent::View::InternetAgent::TnsWebBrowser
//
// Наследник от стандартного компонента, для заточек в F1
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

// ! Полностью генерируется с модели. Править руками - нельзя. !

{$Include w:\garant6x\implementation\Garant\nsDefine.inc}

interface

{$If not defined(Admin) AND not defined(Monitorings)}
uses
  Messages,
  nsWebBrowserPrim,
  OvcController,
  afwInterfaces,
  Classes
  ;
{$IfEnd} //not Admin AND not Monitorings

{$If not defined(Admin) AND not defined(Monitorings)}
type
 _afwShortcutsHandler_Parent_ = TnsWebBrowserPrim;
 {$Include w:\common\components\gui\Garant\AFW\implementation\afwShortcutsHandler.imp.pas}
 _evStyleTableListner_Parent_ = _afwShortcutsHandler_;
 {$Include w:\common\components\gui\Garant\Everest\evStyleTableListner.imp.pas}
 TnsWebBrowser = class(_evStyleTableListner_)
  {* Наследник от стандартного компонента, для заточек в F1 }
 private
 // private fields
   f_FPUCtrlWord : Word;
   f_Scale : Integer;
    {* Поле для свойства Scale}
 private
 // private methods
    {$If not defined(Admin) AND not defined(Monitorings) AND not defined(XE)}
   procedure DocumentComplete(Sender: TObject;
     const pDisp: IDispatch;
     var URL: OleVariant);
     {* Документ готов к работе }
    {$IfEnd} //not Admin AND not Monitorings AND not XE
   procedure ApplyZoom;
     {* Выставляет Zoom из таблицы стилей }
   procedure DocumentCompleteXE(Sender: TObject;
     const pDisp: IDispatch;
     const URL: OleVariant);
   procedure WMSize(var aMsg: TWMSize); message WM_Size;
 protected
 // property methods
   procedure pm_SetScale(aValue: Integer);
 protected
 // realized methods
   {$If not defined(DesignTimeLibrary)}
   procedure DoStyleTableChanged; override;
   {$IfEnd} //not DesignTimeLibrary
 protected
 // overridden protected methods
   procedure InitFields; override;
    {$If defined(l3HackedVCL) AND not defined(DesignTimeLibrary)}
   procedure ForceWMSize(aWidth: Integer;
     aHeight: Integer); override;
    {$IfEnd} //l3HackedVCL AND not DesignTimeLibrary
 public
 // overridden public methods
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 public
 // public methods
   function ScaleDisabled: Boolean;
     {* Масштабирование запрещено }
 public
 // public properties
   property Scale: Integer
     read f_Scale
     write pm_SetScale;
     {* Масштаб }
 end;//TnsWebBrowser
{$IfEnd} //not Admin AND not Monitorings

implementation

{$If not defined(Admin) AND not defined(Monitorings)}
uses
  evStyleTableTools,
  Variants,
  StrUtils,
  nsWebBrowserHelper,
  l3SysUtils,
  l3Base,
  SysUtils,
  OvcConst,
  Controls,
  Windows,
  Forms
  {$If not defined(DesignTimeLibrary)}
  ,
  evStyleTableSpy
  {$IfEnd} //not DesignTimeLibrary
  
  ;
{$IfEnd} //not Admin AND not Monitorings

{$If not defined(Admin) AND not defined(Monitorings)}

{$Include w:\common\components\gui\Garant\AFW\implementation\afwShortcutsHandler.imp.pas}

{$Include w:\common\components\gui\Garant\Everest\evStyleTableListner.imp.pas}

// start class TnsWebBrowser

{$If not defined(Admin) AND not defined(Monitorings) AND not defined(XE)}
procedure TnsWebBrowser.DocumentComplete(Sender: TObject;
  const pDisp: IDispatch;
  var URL: OleVariant);
//#UC START# *49F0457A016C_49ECB8E002B0_var*
//#UC END# *49F0457A016C_49ECB8E002B0_var*
begin
//#UC START# *49F0457A016C_49ECB8E002B0_impl*
 DocumentCompleteXE(Sender, pDisp, URL);
//#UC END# *49F0457A016C_49ECB8E002B0_impl*
end;//TnsWebBrowser.DocumentComplete
{$IfEnd} //not Admin AND not Monitorings AND not XE

procedure TnsWebBrowser.ApplyZoom;
//#UC START# *49F062A50141_49ECB8E002B0_var*
//#UC END# *49F062A50141_49ECB8E002B0_var*
begin
//#UC START# *49F062A50141_49ECB8E002B0_impl*
 try
  if not VarIsClear{VarIsNull}(OleObject) AND
     not VarIsClear{VarIsNull}(OleObject.Document) then
   if not VarIsClear{VarIsNull}(OleObject.Document.Body) then
   begin
    if ScaleDisabled then
     OleObject.Document.Body.Style.Zoom := 1
    else
     OleObject.Document.Body.Style.Zoom := f_Scale / 100{evGetDefaultZoom(12)};
   end;//not VarIsClear{VarIsNull}(OleObject.Document.Body)
 except
  on E: Exception do
   l3System.Exception2Log(E);
 end;//try..except
//#UC END# *49F062A50141_49ECB8E002B0_impl*
end;//TnsWebBrowser.ApplyZoom

procedure TnsWebBrowser.DocumentCompleteXE(Sender: TObject;
  const pDisp: IDispatch;
  const URL: OleVariant);
//#UC START# *5175412302EE_49ECB8E002B0_var*
//#UC END# *5175412302EE_49ECB8E002B0_var*
begin
//#UC START# *5175412302EE_49ECB8E002B0_impl*
 ApplyZoom;
//#UC END# *5175412302EE_49ECB8E002B0_impl*
end;//TnsWebBrowser.DocumentCompleteXE

function TnsWebBrowser.ScaleDisabled: Boolean;
//#UC START# *4BB3665300BC_49ECB8E002B0_var*
//#UC END# *4BB3665300BC_49ECB8E002B0_var*
begin
//#UC START# *4BB3665300BC_49ECB8E002B0_impl*
 Result := ANSIStartsText('http://mirror2.garant.ru', LocationURL) OR
           ANSIStartsText('http://gim.garant.ru', LocationURL);
//#UC END# *4BB3665300BC_49ECB8E002B0_impl*
end;//TnsWebBrowser.ScaleDisabled

procedure TnsWebBrowser.pm_SetScale(aValue: Integer);
//#UC START# *4BB32FCD0157_49ECB8E002B0set_var*
//#UC END# *4BB32FCD0157_49ECB8E002B0set_var*
begin
//#UC START# *4BB32FCD0157_49ECB8E002B0set_impl*
 if (f_Scale <> aValue) then
 begin
  f_Scale := aValue;
  ApplyZoom;
 end;//f_Scale <> aValue
//#UC END# *4BB32FCD0157_49ECB8E002B0set_impl*
end;//TnsWebBrowser.pm_SetScale

procedure TnsWebBrowser.WMSize(var aMsg: TWMSize);
//#UC START# *4E9574530051_49ECB8E002B0_var*
{$If not defined(DesignTimeLibrary)}
{$IfDef Never}
var
  Extent: TPoint;
  W, H: Integer;
  l_Res : HResult;
{$EndIf Never}
{$IfEnd}
//#UC END# *4E9574530051_49ECB8E002B0_var*
begin
//#UC START# *4E9574530051_49ECB8E002B0_impl*
 inherited;
 {$If not defined(DesignTimeLibrary)}
 {$IfDef Never}
 Exit;
 if VarIsClear{VarIsNull}(OleObject) OR
    VarIsClear{VarIsNull}(OleObject.Document) then
  Exit;
(* W := OleObject.Document.Body.OffsetWidth;
 H := OleObject.Document.Body.OffsetHeight;*)
(* W := OleObject.Document.Body.Width;
 H := OleObject.Document.Body.Height;*)
(* OleObject.Document.Body.OffsetWidth := Self.Width;
 OleObject.Document.Body.OffsetHeight := Self.Height;*)
(* W := OleObject.Document.{Window.}InnerWidth;
 H := OleObject.Document.{Window.}InnerHeight;*)
// Exit;
 if l3NeedsHackFor64System then
 begin
(*  EnumChildWindows(WindowHandle,
                   @EnumChildWindowProc,
                   LParam(LoWord(Width) + (LoWord(Height) shl 16))
                   {TMessage(aMsg).lParam});
  l_Res := THackOleControl(Self).FOleObject.GetExtent(DVASPECT_CONTENT, Extent);
  if (l_Res <> S_OK) then
   Assert(false);
  W := MulDiv(Extent.X, Screen.PixelsPerInch, 2540);
  H := MulDiv(Extent.Y, Screen.PixelsPerInch, 2540);
//  ControlInterface.Width := W;
//  ControlInterface.Height := H;
  ControlInterface.Width := Self.Width;
  ControlInterface.Height := Self.Height;*)
  ControlInterface.Refresh;
 end;//l3NeedsHackFor64System
 {$EndIf Never}
 {$IfEnd} //not DesignTimeLibrary
//#UC END# *4E9574530051_49ECB8E002B0_impl*
end;//TnsWebBrowser.WMSize

{$If not defined(DesignTimeLibrary)}
procedure TnsWebBrowser.DoStyleTableChanged;
//#UC START# *4A485B710126_49ECB8E002B0_var*
//#UC END# *4A485B710126_49ECB8E002B0_var*
begin
//#UC START# *4A485B710126_49ECB8E002B0_impl*
 ApplyZoom;
//#UC END# *4A485B710126_49ECB8E002B0_impl*
end;//TnsWebBrowser.DoStyleTableChanged
{$IfEnd} //not DesignTimeLibrary

constructor TnsWebBrowser.Create(AOwner: TComponent);
//#UC START# *47D1602000C6_49ECB8E002B0_var*
//#UC END# *47D1602000C6_49ECB8E002B0_var*
begin
//#UC START# *47D1602000C6_49ECB8E002B0_impl*
 // Попытка лечения EZeroDivide из mshtml.dll от IE 10
 // http://mdp.garant.ru/pages/viewpage.action?pageId=475141873
 f_FPUCtrlWord := Get8087CW;
 Set8087CW($027F);
 inherited;
 OnDocumentComplete := {$IfDef XE}Self.DocumentCompleteXE{$Else}Self.DocumentComplete{$EndIf};
//#UC END# *47D1602000C6_49ECB8E002B0_impl*
end;//TnsWebBrowser.Create

destructor TnsWebBrowser.Destroy;
//#UC START# *48077504027E_49ECB8E002B0_var*
//#UC END# *48077504027E_49ECB8E002B0_var*
begin
//#UC START# *48077504027E_49ECB8E002B0_impl*
 // http://mdp.garant.ru/pages/viewpage.action?pageId=475141873
 Set8087CW(f_FPUCtrlWord);
 inherited;
//#UC END# *48077504027E_49ECB8E002B0_impl*
end;//TnsWebBrowser.Destroy

procedure TnsWebBrowser.InitFields;
//#UC START# *49F0577C02ED_49ECB8E002B0_var*
//#UC END# *49F0577C02ED_49ECB8E002B0_var*
begin
//#UC START# *49F0577C02ED_49ECB8E002B0_impl*
 inherited;
 f_Scale := 100;
//#UC END# *49F0577C02ED_49ECB8E002B0_impl*
end;//TnsWebBrowser.InitFields

{$If defined(l3HackedVCL) AND not defined(DesignTimeLibrary)}
procedure TnsWebBrowser.ForceWMSize(aWidth: Integer;
  aHeight: Integer);
//#UC START# *4E955E8F0237_49ECB8E002B0_var*
//#UC END# *4E955E8F0237_49ECB8E002B0_var*
begin
//#UC START# *4E955E8F0237_49ECB8E002B0_impl*
 inherited;
(* SendMessage(WindowHandle,
             WM_Size,
             0, LParam(LoWord(Width) + (LoWord(Height) shl 16)));*)
(* SendMessage(WindowHandle,
             WM_Size,
             0, LParam(LoWord(aWidth) + (LoWord(AHeight) shl 16)));
 EnumChildWindows(WindowHandle,
                  @EnumChildWindowProc,
                  LParam(LoWord(aWidth) + (LoWord(AHeight) shl 16)));*)
(* ShowScrollBar(WindowHandle, SB_Horz, true);
 ShowScrollBar(WindowHandle, SB_Vert, true);*)
//#UC END# *4E955E8F0237_49ECB8E002B0_impl*
end;//TnsWebBrowser.ForceWMSize
{$IfEnd} //l3HackedVCL AND not DesignTimeLibrary

{$IfEnd} //not Admin AND not Monitorings

end.

{$IfNDef nevDocumentContainerDecorationRules_imp}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "Everest"
// Модуль: "w:/common/components/gui/Garant/Everest/nevDocumentContainerDecorationRules.imp.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi::Everest::Aspects::nevDocumentContainerDecorationRules
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Define nevDocumentContainerDecorationRules_imp}
 _nevDocumentContainerDecorationRules_ = {mixin} class(_nevDocumentContainerDecorationRules_Parent_)
 public
 // realized methods
   function AllowsThisDecor(aFI: TnevFormatInfoPrim;
     aType: TnevDecorType): Boolean;
     {* Разрешает ли контейтер документа применять указанное декорирование }
 protected
 // protected methods
   function GetAllowsThisDecor(aFI: TnevFormatInfoPrim;
     aType: TnevDecorType): Boolean; virtual;
     {* Разрешает ли контейтер документа применять указанное декорирование }
 end;//_nevDocumentContainerDecorationRules_

{$Else nevDocumentContainerDecorationRules_imp}

// start class _nevDocumentContainerDecorationRules_

function _nevDocumentContainerDecorationRules_.GetAllowsThisDecor(aFI: TnevFormatInfoPrim;
  aType: TnevDecorType): Boolean;
//#UC START# *4F33E3A20056_4F33E5FD009E_var*
//#UC END# *4F33E3A20056_4F33E5FD009E_var*
begin
//#UC START# *4F33E3A20056_4F33E5FD009E_impl*
 Result := true;
//#UC END# *4F33E3A20056_4F33E5FD009E_impl*
end;//_nevDocumentContainerDecorationRules_.GetAllowsThisDecor

function _nevDocumentContainerDecorationRules_.AllowsThisDecor(aFI: TnevFormatInfoPrim;
  aType: TnevDecorType): Boolean;
//#UC START# *4F33E2A30116_4F33E5FD009E_var*
//#UC END# *4F33E2A30116_4F33E5FD009E_var*
begin
//#UC START# *4F33E2A30116_4F33E5FD009E_impl*
 Result := {_Instance_R_}(Self).GetAllowsThisDecor(aFI, aType);
//#UC END# *4F33E2A30116_4F33E5FD009E_impl*
end;//_nevDocumentContainerDecorationRules_.AllowsThisDecor

{$EndIf nevDocumentContainerDecorationRules_imp}

{$IfNDef nsEditionsDecorationRules_imp}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "Everest"
// Модуль: "w:/common/components/gui/Garant/Everest/nsEditionsDecorationRules.imp.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi::Everest::Aspects::nsEditionsDecorationRules
//
// Правила оформления декораций для СР и ОИД
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Define nsEditionsDecorationRules_imp}
 _nsEditionsDecorationRules_ = {mixin} class(_nsEditionsDecorationRules_Parent_)
  {* Правила оформления декораций для СР и ОИД }
 protected
 // overridden protected methods
   function GetAllowsThisDecor(aFI: TnevFormatInfoPrim;
     aType: TnevDecorType): Boolean; override;
     {* Разрешает ли контейтер документа применять указанное декорирование }
 end;//_nsEditionsDecorationRules_

{$Else nsEditionsDecorationRules_imp}

// start class _nsEditionsDecorationRules_

function _nsEditionsDecorationRules_.GetAllowsThisDecor(aFI: TnevFormatInfoPrim;
  aType: TnevDecorType): Boolean;
//#UC START# *4F33E3A20056_4F33E7CF0393_var*
//#UC END# *4F33E3A20056_4F33E7CF0393_var*
begin
//#UC START# *4F33E3A20056_4F33E7CF0393_impl*
 if (aType = nev_dtFooter) AND
    (aFI <> nil) AND
    (aFI.Obj.IntA[k2_tiStyle] = ev_saFooterForChangesInfo) then
  // - не показываем ссылку на справку
  // http://mdp.garant.ru/pages/viewpage.action?pageId=321988011  
  Result := false  
 else
  Result := inherited GetAllowsThisDecor(aFI, aType);
//#UC END# *4F33E3A20056_4F33E7CF0393_impl*
end;//_nsEditionsDecorationRules_.GetAllowsThisDecor

{$EndIf nsEditionsDecorationRules_imp}

{$IfNDef PrintViewDecorationRules_imp}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//
// Библиотека "Everest"
// Модуль: "w:/common/components/gui/Garant/Everest/PrintViewDecorationRules.imp.pas"
// Родные Delphi интерфейсы (.pas)
// Generated from UML model, root element: Impurity::Class Shared Delphi::Everest::Aspects::PrintViewDecorationRules
//
// Правила вывода декораций на печать
//
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

{$Define PrintViewDecorationRules_imp}
 _nsEditionsDecorationRules_Parent_ = _PrintViewDecorationRules_Parent_;
 {$Include ..\Everest\nsEditionsDecorationRules.imp.pas}
 _PrintViewDecorationRules_ = {mixin} class(_nsEditionsDecorationRules_)
  {* Правила вывода декораций на печать }
 protected
 // overridden protected methods
   function GetAllowsThisDecor(aFI: TnevFormatInfoPrim;
     aType: TnevDecorType): Boolean; override;
     {* Разрешает ли контейтер документа применять указанное декорирование }
 end;//_PrintViewDecorationRules_

{$Else PrintViewDecorationRules_imp}

{$Include ..\Everest\nsEditionsDecorationRules.imp.pas}

// start class _PrintViewDecorationRules_

function _PrintViewDecorationRules_.GetAllowsThisDecor(aFI: TnevFormatInfoPrim;
  aType: TnevDecorType): Boolean;
//#UC START# *4F33E3A20056_4F4B4B10001B_var*
//#UC END# *4F33E3A20056_4F4B4B10001B_var*
begin
//#UC START# *4F33E3A20056_4F4B4B10001B_impl*
 if (aType = nev_dtHeader) AND
    (aFI <> nil) AND
    (aFI.Obj.IntA[k2_tiStyle] = ev_saHeaderForChangesInfo) then
  // - не показываем ссылку на справку
  // http://mdp.garant.ru/pages/viewpage.action?pageId=321988011
  // (!)(!)(+)(!)(!) http://mdp.garant.ru/pages/viewpage.action?pageId=321986755  
  Result := false  
 else
  Result := inherited GetAllowsThisDecor(aFI, aType);
//#UC END# *4F33E3A20056_4F4B4B10001B_impl*
end;//_PrintViewDecorationRules_.GetAllowsThisDecor

{$EndIf PrintViewDecorationRules_imp}

Я бы снабдил бы это ещё диаграммами на UML, но они к сожалению сейчас - недоступны.

И ещё вернёмся к НАЧАЛУ - " а не выбирать из готовых реализаций и задумываться уже о решении бизнес задач".

Хотел бы я иметь ГОТОВУЮ реализацию ГАРАНТа или хотя бы "текстового редактора". На все 100% удовлетворяющую МОИМ ЗАДАЧАМ.

Но их - НЕ БЫЛО. И я за 17-ть лет работы в ГАРАНТе и 25-ть лет работы "вообще" - их сделал.

О чём и "пытаюсь рассказать", а мне говорят - "фууу... изобретаете велосипед".

ГДЕ? ГДЕ! УЖЕ созданный велосипед. Покажите мне! Я бы на нём бы поездил бы.

Ну и СКАЖИТЕ мне что-то вроде Java, C# или Python (к примеру).

И что?!

РЕБЯТА! Я вот уже ОДНАЖДЫ "пересел" на другой велосипед - xCode & Objective-C. Но!

Ну НЕТУ ТАМ готовых решений! НЕТУ!

Да! Есть stl и CoreText. ЕСТЬ!

Но это - НЕ ГОТОВЫЕ решения. Это опять же - ЗАДЕЛ для "применения мозгов и ПОДХОДОВ". Не более того.