From 805f109609466600dfad84fccfc7bdbbbdbb7bf3 Mon Sep 17 00:00:00 2001 From: Thulio Bittencourt Date: Fri, 17 Jul 2020 11:02:05 -0300 Subject: [PATCH] Commit Inicial --- README.md | 223 ++ Router4Delphi.dpk | 57 + Router4Delphi.dproj | 724 ++++ Router4Delphi.dproj.local | 32 + Router4Delphi.identcache | Bin 0 -> 19215 bytes Router4Delphi.res | Bin 0 -> 664 bytes .../Demo/Router4DelphiDemo.View.Principal.fmx | 11 + .../Demo/Router4DelphiDemo.View.Principal.pas | 24 + sample/Demo/Router4DelphiDemo.dpr | 19 + sample/Demo/Router4DelphiDemo.dproj | 910 +++++ sample/Demo/Router4DelphiDemo.dproj.local | 28 + sample/Demo/Router4DelphiDemo.identcache | Bin 0 -> 1859 bytes sample/Demo/Router4DelphiDemo.res | Bin 0 -> 112160 bytes ...ter4DelphiDemo.View.Components.Sidebar.fmx | 60 + ...ter4DelphiDemo.View.Components.Sidebar.pas | 39 + .../Router4DelphiDemo.Views.Layouts.Main.fmx | 56 + .../Router4DelphiDemo.Views.Layouts.Main.pas | 61 + ...Router4DelphiDemo.View.Pages.Cadastros.fmx | 27 + ...Router4DelphiDemo.View.Pages.Cadastros.pas | 36 + .../Router4DelphiDemo.View.Pages.Index.fmx | 27 + .../Router4DelphiDemo.View.Pages.Index.pas | 47 + .../Router4DelphiDemo.View.Principal.fmx | 18 + .../Router4DelphiDemo.View.Principal.pas | 36 + .../Routers/Router4DelphiDemo.View.Router.pas | 45 + .../SimpleDemo.View.Components.Button01.fmx | 47 + .../SimpleDemo.View.Components.Button01.pas | 85 + .../SimpleDemo.View.Page.Cadastros.Sub.fmx | 27 + .../SimpleDemo.View.Page.Cadastros.Sub.pas | 45 + .../SimpleDemo.View.Page.Cadastros.fmx | 74 + .../SimpleDemo.View.Page.Cadastros.pas | 114 + .../SimpleDemo.View.Page.Principal.fmx | 47 + .../SimpleDemo.View.Page.Principal.pas | 69 + .../SimpleDemo/SimpleDemo.View.Principal.fmx | 71 + .../SimpleDemo/SimpleDemo.View.Principal.pas | 79 + sample/SimpleDemo/SimpleDemo.dpr | 19 + sample/SimpleDemo/SimpleDemo.dproj | 904 +++++ sample/SimpleDemo/SimpleDemo.dproj.local | 21 + sample/SimpleDemo/SimpleDemo.identcache | Bin 0 -> 493 bytes sample/SimpleDemo/SimpleDemo.res | Bin 0 -> 112124 bytes src/DuckListU.pas | 337 ++ src/EventBus.Core.pas | 362 ++ src/EventBus.Subscribers.pas | 241 ++ src/ObjectsMappers.pas | 3033 +++++++++++++++++ src/RTTIUtilsU.pas | 850 +++++ src/Router4D.History.pas | 216 ++ src/Router4D.Interfaces.pas | 67 + src/Router4D.Link.pas | 147 + src/Router4D.Props.pas | 273 ++ src/Router4D.Render.pas | 61 + src/Router4D.Sidebar.pas | 182 + src/Router4D.Switch.pas | 73 + src/Router4D.Utils.pas | 82 + src/Router4D.pas | 90 + 53 files changed, 10096 insertions(+) create mode 100644 Router4Delphi.dpk create mode 100644 Router4Delphi.dproj create mode 100644 Router4Delphi.dproj.local create mode 100644 Router4Delphi.identcache create mode 100644 Router4Delphi.res create mode 100644 sample/Demo/Router4DelphiDemo.View.Principal.fmx create mode 100644 sample/Demo/Router4DelphiDemo.View.Principal.pas create mode 100644 sample/Demo/Router4DelphiDemo.dpr create mode 100644 sample/Demo/Router4DelphiDemo.dproj create mode 100644 sample/Demo/Router4DelphiDemo.dproj.local create mode 100644 sample/Demo/Router4DelphiDemo.identcache create mode 100644 sample/Demo/Router4DelphiDemo.res create mode 100644 sample/Demo/Views/Components/Router4DelphiDemo.View.Components.Sidebar.fmx create mode 100644 sample/Demo/Views/Components/Router4DelphiDemo.View.Components.Sidebar.pas create mode 100644 sample/Demo/Views/Layouts/Router4DelphiDemo.Views.Layouts.Main.fmx create mode 100644 sample/Demo/Views/Layouts/Router4DelphiDemo.Views.Layouts.Main.pas create mode 100644 sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Cadastros.fmx create mode 100644 sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Cadastros.pas create mode 100644 sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Index.fmx create mode 100644 sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Index.pas create mode 100644 sample/Demo/Views/Router4DelphiDemo.View.Principal.fmx create mode 100644 sample/Demo/Views/Router4DelphiDemo.View.Principal.pas create mode 100644 sample/Demo/Views/Routers/Router4DelphiDemo.View.Router.pas create mode 100644 sample/SimpleDemo/SimpleDemo.View.Components.Button01.fmx create mode 100644 sample/SimpleDemo/SimpleDemo.View.Components.Button01.pas create mode 100644 sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.Sub.fmx create mode 100644 sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.Sub.pas create mode 100644 sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.fmx create mode 100644 sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.pas create mode 100644 sample/SimpleDemo/SimpleDemo.View.Page.Principal.fmx create mode 100644 sample/SimpleDemo/SimpleDemo.View.Page.Principal.pas create mode 100644 sample/SimpleDemo/SimpleDemo.View.Principal.fmx create mode 100644 sample/SimpleDemo/SimpleDemo.View.Principal.pas create mode 100644 sample/SimpleDemo/SimpleDemo.dpr create mode 100644 sample/SimpleDemo/SimpleDemo.dproj create mode 100644 sample/SimpleDemo/SimpleDemo.dproj.local create mode 100644 sample/SimpleDemo/SimpleDemo.identcache create mode 100644 sample/SimpleDemo/SimpleDemo.res create mode 100644 src/DuckListU.pas create mode 100644 src/EventBus.Core.pas create mode 100644 src/EventBus.Subscribers.pas create mode 100644 src/ObjectsMappers.pas create mode 100644 src/RTTIUtilsU.pas create mode 100644 src/Router4D.History.pas create mode 100644 src/Router4D.Interfaces.pas create mode 100644 src/Router4D.Link.pas create mode 100644 src/Router4D.Props.pas create mode 100644 src/Router4D.Render.pas create mode 100644 src/Router4D.Sidebar.pas create mode 100644 src/Router4D.Switch.pas create mode 100644 src/Router4D.Utils.pas create mode 100644 src/Router4D.pas diff --git a/README.md b/README.md index cb8190b..23cdf69 100644 --- a/README.md +++ b/README.md @@ -1,2 +1,225 @@ # Router4Delphi Framework para Criação de Rotas de Telas para FMX + +O Router4Delphi tem o objetivo de facilitar a chamada de telas e embed de Layouts em aplicações FMX, reduzindo o acoplamento das telas de dando mais dinâmismo e práticidade na construção de interfaces ricas em Delphi + +## Instalação + +Basta registrar no Library Path do seu Delphi o caminho da pasta SRC da Biblioteca + +## Primeiros Passos + +Para utilizar o Router4Delphi para criar suas rotas, você deve realizar a uses do Router4D. + +## Criação de uma Tela para Roteamento + +Para que o sistema de Rotas funcione você deve criar um novo formulário FMX e Implementar a Interface iRouter4DComponent ela pertence a unit Router4D.Interfaces portanto a mesma deve ser incluida nas suas Units. + +Toda a construção das telas baseadas em rotas utilizar TLayouts para embedar as chamadas das telas, dessa forma é preciso que sua nova tela tenha um TLayout principal e todos os demais componentes devem ser incluídos dentro desse layout. + +A Implementação da Interface iRouter4DComponent requer a declaração de dois métodos ( Render e UnRender ), o Render é chamado sempre que uma rota aciona a tela, e o UnRender sempre que ela saí de exibição. + +Abaixo o Código de uma tela simples implementando a interface iRouter4DComponent e pronta para ser utilizada. + +Crie um Novo Formulario na sua Aplicação, inclua nele um Layout alinhado AlClient e implemente os métodos como abaixo. + +```delphi + +unit PrimeiraTela; + +interface + +uses + System.SysUtils, + System.Types, + System.UITypes, + System.Classes, + System.Variants, + FMX.Types, + FMX.Controls, + FMX.Forms, + FMX.Graphics, + FMX.Dialogs, + Router4D.Interfaces; + +type + TPrimeiraTela = class(TForm, iRouter4DComponent) + Layout1: TLayout; + private + { Private declarations } + public + { Public declarations } + function Render : TFMXObject; + procedure UnRender; + end; + +var + PrimeiraTela: TPrimeiraTela; + +implementation + +{$R *.fmx} + +{ TForm3 } + +function TPrimeiraTela.Render: TFMXObject; +begin + Result := Layout1; +end; + +procedure TPrimeiraTela.UnRender; +begin + +end; + +end. +``` + +Perceba que no método Render nós definimos como Result o Layout1, isso é necessário pois esse layout será embedado sempre que a rota for acionada. + +## Registrando a Rota para a Tela + +Agora que já temos uma tela pronta para ser registrada vamos ao processo que deixará a nossa tela pronta para ser acionada a qualquer momento. + +Para registrar uma rota é necessário declarar a Uses Router4D ela fornece acesso a todos os métodos da biblioteca e em muito dos casos será o único acoplamento necessário nas suas Views. + +Uma vez declarada basta acionar o método abaixo para declarar o form que criamos anteriormente como uma rota. + +No formPrincipal da sua Aplicação, dentro do método onCreate execute o método abaixo para registrar a Rota para o Form TPrimeiraTela + +```delphi + +procedure TformPrincipal.FormCreate(Sender: TObject); +begin + TRouter4D.Switch.Router('Inicio', TPrimeiraTela); +end; +``` + +Pronto já temos uma Rota criada, dessa forma os nossos forms não precisam mais conhecer a uses da nossa tela, basta acionar nosso sistema de rotas e pedir a criação da rota "Inicio" que a mesma será exibida no LayoutMain da aplicação. + +Você pode criar uma Unit Separada somente para Registrar as Rotas ou então chamar um metodo no onCreate do seu formulario principal para isso. + +## Definindo o Render Principal + +Já temos uma tela e uma rota para utilizarmos, agora precisamos definir apenas onde está rota renderizará o layout, ou seja, qual será o nosso Objeto que vai receber as telas embedadas. + +Para isso no formPrincipal da sua aplicação, declare a uses Router4D e no onCreate do mesmo faça a seguinte chamada. + +Lembrando que no passo anterios nós já tinhamos usado o onCreate do formPrincipal para Registrar a Rota. + +```delphi + +procedure TformPrincipal.FormCreate(Sender: TObject); +begin + TRouter4D.Switch.Router('Inicio', TPrimeiraTela); + + TRouter4D.Render.SetElement(Layout1, Layout1); +end; + +``` + +O método Render é responsável por definir na biblioteca quais serão os LayoutsMain e Index da Aplicação. + +O Render recebe como genéric o nome da Classe da nossa tela inicial, ela será renderizada quando a aplicação abrir dentro do Layout que foi informado como primeiro parametro do SetElement + +O primeiro parametro do SetElement está definindo em qual Layout a biblioteca irá renderizar uma nova tela sempre que um Link da rota for chamado. + +O Segundo parametro do SetElement está definindo qual é o layout Index da aplicação, assim quando um IndexLink for chamado ele será renderizado nesse layout, mais para frente explicarei sobre o IndexLink. + +Pronto, agora ao abrir a sua aplicação você já terá o Layout do Formulario TPrimeiraTela sendo renderizado dentro do Layout1 do formPrincipal da sua aplicação. + +## Criando uma Segunda Tela + +Para que possamos ver o componente em ação de fato e todos os seus benefícios, crie uma nova tela semelhante a que fizemos no inicio, adicionando um Layout alClient nela e implementando os métodos Render e UnRender. + +Coloque dentro do Layout um Label por exemplo, escrito segunda tela apenas para termos a certeza que tudo funcionou corretamente. + +```delphi + +unit SegundaTela; + +interface + +uses + System.SysUtils, + System.Types, + System.UITypes, + System.Classes, + System.Variants, + FMX.Types, + FMX.Controls, + FMX.Forms, + FMX.Graphics, + FMX.Dialogs, + Router4D.Interfaces; + +type + TSegundaTela = class(TForm, iRouter4DComponent) + Layout1: TLayout; + private + { Private declarations } + public + { Public declarations } + function Render : TFMXObject; + procedure UnRender; + end; + +var + SegundaTela: TSegundaTela; + +implementation + +{$R *.fmx} + +{ TSegundaTela } + +function TSegundaTela.Render: TFMXObject; +begin + Result := Layout1; +end; + +procedure TSegundaTela.UnRender; +begin + +end; + +end. +``` +## Registrando a Segunda tela na Rota + +Agora que criamos uma nova tela precisamos registrar ela no sistema de Rotas, então vamos voltar ao onCreate e fazer esse registros, vamos chamar essa tela de Tela2. + +```delphi + +procedure TformPrincipal.FormCreate(Sender: TObject); +begin + TRouter4D.Switch.Router('Inicio', TPrimeiraTela); + + TRouter4D.Switch.Router('Tela2', TSegundaTela); + + TRouter4D.Render.SetElement(Layout1, Layout1); +end; + +``` + + +## Acionando a nova tela atráves da Rota utilizando o Link + +Agora que vem a mágica, volte na TPrimeiraTela e coloque um botão lá e vamos usar o sistema de Links do Router4D para chamar a TSegundaTela sem precisar dar uses nela. + +Basta chamar o método abaixo no Evento de Clique do Botão. + +```delphi +procedure TPrimeiraTela.Button1Click(Sender: TObject); +begin + TRouter4D.Link.&To('Tela2'); +end; +``` + +Perceba que a TPrimeiraTela não conhece a TSegundaTela pois o uses da mesma foi dado apenas no formPrincipal onde é necessário para o Registro das Rotas. + +Se você deseja deixar isso mais organizado, eu sugiro inclusive que você crie uma Unit separada apenas para registro das Rotas com um class procedure e faça a chamada desse método no onCreate do formPrincipal. + +Dessa forma damos fim a um monte de referencias cruzadas e acoplamento entre as telas. + + diff --git a/Router4Delphi.dpk b/Router4Delphi.dpk new file mode 100644 index 0000000..224658b --- /dev/null +++ b/Router4Delphi.dpk @@ -0,0 +1,57 @@ +package Router4Delphi; + +{$R *.res} +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION OFF} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES ON} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DEFINE DEBUG} +{$ENDIF IMPLICITBUILDING} +{$IMPLICITBUILD ON} + +requires + rtl, + xmlrtl, + fmx, + soaprtl, + dbrtl, + DbxCommonDriver, + FireDAC, + FireDACCommonDriver, + FireDACCommon; + +contains + Router4D.History in 'src\Router4D.History.pas', + Router4D.Interfaces in 'src\Router4D.Interfaces.pas', + Router4D.Link in 'src\Router4D.Link.pas', + Router4D in 'src\Router4D.pas', + Router4D.Props in 'src\Router4D.Props.pas', + Router4D.Switch in 'src\Router4D.Switch.pas', + Router4D.Utils in 'src\Router4D.Utils.pas', + DuckListU in 'src\DuckListU.pas', + EventBus.Core in 'src\EventBus.Core.pas', + EventBus.Subscribers in 'src\EventBus.Subscribers.pas', + ObjectsMappers in 'src\ObjectsMappers.pas', + RTTIUtilsU in 'src\RTTIUtilsU.pas', + Router4D.Sidebar in 'src\Router4D.Sidebar.pas', + Router4D.Render in 'src\Router4D.Render.pas'; + +end. diff --git a/Router4Delphi.dproj b/Router4Delphi.dproj new file mode 100644 index 0000000..46ce556 --- /dev/null +++ b/Router4Delphi.dproj @@ -0,0 +1,724 @@ + + + {3810FA8C-A44A-4F47-AEB3-80819D3485B2} + Router4Delphi.dpk + 19.0 + FMX + True + Debug + Win32 + 1 + Package + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + true + true + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + All + Router4Delphi + + + None + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + None + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + + MainSource + + + + + + + + + + + + + + + + + + + + + + + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Package + + + + Router4Delphi.dpk + + + + False + False + False + True + False + + + + + true + + + + + true + + + + + true + + + + + Router4Delphi.bpl + true + + + + + 1 + + + 0 + + + + + classes + 1 + + + classes + 1 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + 1 + + + 0 + + + + + 1 + .framework + + + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + + + + + 1 + + + 1 + + + 1 + + + + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + 12 + + + + + diff --git a/Router4Delphi.dproj.local b/Router4Delphi.dproj.local new file mode 100644 index 0000000..741add1 --- /dev/null +++ b/Router4Delphi.dproj.local @@ -0,0 +1,32 @@ + + + + 2020/07/13 22:38:51.000.784,=rtl.dcp + 2020/07/13 22:38:58.000.612,C:\Users\thuli\Documents\Embarcadero\Studio\Projects\Router4Delphi.dproj=C:\Users\thuli\Documents\Embarcadero\Studio\Projects\Package1.dproj + 2020/07/13 22:39:07.000.751,D:\Projetos\Frameworks\Router4Delphi\Router4Delphi.dproj=C:\Users\thuli\Documents\Embarcadero\Studio\Projects\Router4Delphi.dproj + 2020/07/13 22:39:18.000.950,=D:\Projetos\Frameworks\Router4Delphi\src\Router4D.pas + 2020/07/13 22:39:18.000.846,=D:\Projetos\Frameworks\Router4Delphi\src\Router4D.History.pas + 2020/07/13 22:39:18.000.879,=D:\Projetos\Frameworks\Router4Delphi\src\Router4D.Interfaces.pas + 2020/07/13 22:39:18.000.985,=D:\Projetos\Frameworks\Router4Delphi\src\Router4D.Props.pas + 2020/07/13 22:39:18.000.922,=D:\Projetos\Frameworks\Router4Delphi\src\Router4D.Link.pas + 2020/07/13 22:39:19.000.075,=D:\Projetos\Frameworks\Router4Delphi\src\Router4D.Utils.pas + 2020/07/13 22:39:19.000.046,=D:\Projetos\Frameworks\Router4Delphi\src\Router4D.Switch.pas + 2020/07/13 22:39:42.000.878,=D:\Projetos\Frameworks\Router4Delphi\src\EventBus.Core.pas + 2020/07/13 22:39:42.000.911,=D:\Projetos\Frameworks\Router4Delphi\src\EventBus.Subscribers.pas + 2020/07/13 22:39:42.000.975,=D:\Projetos\Frameworks\Router4Delphi\src\ObjectsMappers.pas + 2020/07/13 22:39:42.000.838,=D:\Projetos\Frameworks\Router4Delphi\src\DuckListU.pas + 2020/07/13 22:39:43.000.018,=D:\Projetos\Frameworks\Router4Delphi\src\RTTIUtilsU.pas + 2020/07/13 22:39:54.000.821,=FireDAC.dcp + 2020/07/13 22:39:54.000.880,=FireDACCommonDriver.dcp + 2020/07/13 22:39:54.000.735,=dbrtl.dcp + 2020/07/13 22:39:54.000.681,=soaprtl.dcp + 2020/07/13 22:39:54.000.780,=DbxCommonDriver.dcp + 2020/07/13 22:39:54.000.598,=xmlrtl.dcp + 2020/07/13 22:39:54.000.644,=fmx.dcp + 2020/07/13 22:39:54.000.918,=FireDACCommon.dcp + 2020/07/14 20:23:48.000.027,=D:\Projetos\Frameworks\Router4Delphi\Unit1.pas + 2020/07/14 20:23:58.000.724,D:\Projetos\Frameworks\Router4Delphi\Unit1.pas=D:\Projetos\Frameworks\Router4Delphi\src\Router4D.Sidebar.pas + 2020/07/14 20:52:39.000.123,=D:\Projetos\Frameworks\Router4Delphi\Unit1.pas + 2020/07/14 20:52:54.000.533,D:\Projetos\Frameworks\Router4Delphi\Unit1.pas=D:\Projetos\Frameworks\Router4Delphi\src\Router4D.Render.pas + + diff --git a/Router4Delphi.identcache b/Router4Delphi.identcache new file mode 100644 index 0000000000000000000000000000000000000000..5dea59ecc3b69bf7e3bccb67dd8104c86bfc1dc3 GIT binary patch literal 19215 zcmbV!OOxAJmYzuBLGYECQmLf&v}bzZb;VSbT3s=oi7+xrRW;ocjQn$_}fi79}Z@xVZN`zw@1QIeGNx z(LYW9;g7GX@)uE;@{jW>UW>c3x|M&tEVs3&UQ9*4xyk-0tHl1~t7VpotGN1V6H6>$ z|NGB>{YrT8M)Eq}{hxpRZ-4l6=ijhew=VsqsHbrqj~4P$TxSwH5or)jXUDVmqNpd| z=jBzL^WTrRvcK9ENu8BNzkDyMyo}Rcc>V`JTW|7Aq%Ob2KQ7B$#6>q-Id@roed5q1+V-HWSw( z%GSacA2yYc(n-qAZjhAp*0@N78`FyiZ^O&W@H|?~mcu+-XLU>)m0rl3_r!-pY-(pI z@|7FXi9LbMiOM|=my4x;QsS*2>TX$duKNOjO|xb!3S*8y!z{k2z=^#O!^QJmyup_i(}pSBqU&YxS> zRaRUdMkiZYm+P>`Kd)dJ0j=>S&bMMXr@yL?Jqdr_#(B1a*iZ6U%5#`ge}i9(s@_eq zBC9j}`XkH0nOEi7i|AqLEqBoI`ms^=a(g8cyhv2u>mrA6gUBe`=Y@szr*V;qTm%dA zo5%JkyUQ`}?POb3qDXebD7vXcoSv1b=*IOhfg0fcZH~etbn4kTBM#@^l6x; zO3HjhdOsw8FyA+J{|?XK=Y8X#tR=OAJ0}wwD%;|hI5%~@8N4nk?M2;8x~w%X+{DR^ z=w9s{dZwEd&MM0Vlp=&v?>3^JD}$1~vbuIiYz_>wa8AlfxK~)N7+glt;&q+n@^x<= z?*=SuWfE~CykTh70x35F>KnDW@G?=2_-XBAp0cJ<+bUVoMw7kyaoBqwR|7sUpR^Yj zsY|jEgW1=!*~^pP&A$C@KxgA$dmHF2OPp7wtoyJw-nSdg5jnhwH;vwI^vbI`&We7hJ;^(PG-}a_`gvSjZ{us>Y+>2XPmA+uf396tS)Q?sZn^3$ zh3LzTNZ=jGFhxvLj+FYeB`9=ArlbYXySuydrvjfTcY~DvWGfA>DZr6c^h5og-~>^p z%C2u}*b~C!Dn{f<$oKqBmA%J4o%uJ%;h+&bjzfX3CyLZN<&*nwL`4Cxw<@b1VoTqM z+1EkkNy`~d;yk}Xc=RrX+~&12#{*t`4YNrhA(>ql_zP{bLY8=bDc1P=r&itDN-G;dJu0AM3Wev)-5XspOydc*C&_Lthl|Oqkj9>FLN);ef~y_fqz9V z!yEbM|MAV=UH-W<={$PWE3zDk?ofv$=w6xK(|J~;jmN0aBRh9}(l#H+C%hvAVa#R%j~0Y7sw7$XUoP%y|lb5 z>T=M?i^CIw+;~q4Dt``6StAjGTW1j{C!VkCfeM%OW1B>+XWz@FZWU)zxV+9dY>T}s zOOswHr@FJMg5^@!{LAUJiJuSUO*e{SdD~sg2PSyKu@Ig(m-?@Z+X9EzvB_Q5aaBK6 zX9|n5*saU0R4UQAwaK6lWZ69wWW3m2#jvhXS|Wf-4ipb0T^$UOP9GbQBWr839UN1h zcuPUK|Gj|yWQj^A4`i<-0Iu+g=&S$Jri1F`7wrwHW1T->Xx z-NPC8KSgHtH3uz$F@y?p5m(>!;u*ub9mLdU93K-s%K*Sa}eV!wt6RtFQe2~IZ z@q@V9aZ0z@yn9}bRd}zJc{pj77XCuc)|-0Qh7L!KHnct&034hE;Q}dCI%#-ek{}=` zNN^NU0^=l%Q`vHBjeEE*LOZg8VhB*WoffD9HUaAHtcp(8mtKZFvx zcl&9@tD&&F!u@$Gwt^4?!GxBbRcutw>_b)`wSbDUU*sNBMD#AVg+dqJ>`#EW^4a_^ zoG1#v_v4%#e|Oj%R4u4M$bBHZhe;TGIadNuivUR*qy~09Qy7frZHR;zp67!GdigrJ z_?&3-orNDq#tN;gnzG{rHBY@)b-BErLEZfeU=2#!qbB1lrbAs=kRrQj>8t^;VHY)& z&CqCUM9Vp;pCFZG1@v)RUNdS6SPN7v9O;!P(J1o;bn;Z-HYFG#sZQOQp`rl@A$-xF z6)Ah@FsgRni<*N~Fh9GTy(JHO2yLlXk`CKg>#_AOE)>Ygx>-#Lr-p-}1huZ&LS=tD z*LqPIR~xzgq=jlu5=#*vq@d!%*&5{LMPXINyZZpHh1m$K8I;z~$fJ;G$+lr;F2@2N z(4fY@T3(y-7Nji{2;L2&MzVeaD2H`=w*ufD$viC5^DIA99&2r_`V18Km`pe-+j7vD zFnE)dITt_wvHe^5iIfav9G*4?Jcw+H{EJA^12zTPB|zz(Lrv0$F;MI_h_b1(TClP~ z(*FCbs^QUn6%H5E$1UfOgvNwIp#S*SL&r;~O?<+W{5u$zAK+MJwY!gIfA{%YvZWfW zakN_h%m4oA&z+9|qDUz-;zgjc^8mo=O7T$$0<`> z>-WjZuwN~^BQQsf<8ov?P{)Z%IvD=sA;I62T+U4zLWRO(5AWAW1jR#8-@b_}kWKX$N?;uKEcpTPv1?e+s9h4w z2`i@uuBuOBAdLmfa$6+=>szFzlI@_ro$d+_P~Hznp1Bx`V!IXN6IFm)wO=W!4geVR8j4DFIE{i7&~WF3O+i@{ z=}4horI`UKTxr{ct&ub*LkNdvVaKd@PyKvA6l0uHt?68WR)j=g6!WqQ$hMjD>wyZ@ zBmw0d6>x&-Hn}CMdVLV#)9bj#v8av*S4Hn2p^jh$jXHR}moNJCn?$TaRdWJ(1G+tyoRm4R(c5JcC#rfWJ8FKvM!4*!e?A|J^%n!oDN$q?bf#tPpjTU z!4QyoIU4v{(0w9RDQ=AMCzGrEYt2}=$Jod%$&^(@Vsw~bG;~fs#ZxsF9jWMIcW#!K zWxl1<+h?$gUqAaH*4DM}I&O-junVkVTgWmZx<#29_*86#)yxW~8U$SJLF?4?%ZV}$ zb0BSvdTW+Mo~SiZ$0J--5~iVq?U4B}JY^PS%=j8Kw6frJOw72un4|LO!4V1EwrXtR z7~q$zZWSIHRwZdJt((5WdB={juwiDlw@sA1PLB0*Jz@%CLJcg$+DKld4pHR zlvR3AXXq>*s%F{he}cP$$k^=YO$Uto$&0WG{D!%VepnRcjz9^qd&)S8ae}FtL_?^Y z7}28j#AJ4|K}T1Pv47a9kQILi!EMHQ2AcoB=PRoDMoMIW{_ym;T2HOn{9*VirmP7wlx_@Ll|;EJuO?u9zgl$P zRfvsVR>1TG)y-%wAy097amanS{IOVq9gXsVsQZSLSr%D?1jp4 zzLMQ}6yTkx*a5t;pvs;kIW{17MKEtjv^6S43O1K;66v zft2H&Iq$u`1M;-)?TsLR8wCRTAv^V;i3j)kF_x`gAtk`P~fj(q<)S=wc zEy}_1Hp^9mYi#i*nJNVSR>f_XBfAIT0ly-$iM0nuITb}<#qP#b^f@cUa9i5J=6K5v z;X^{^_Bhf5%&xPf8*Sh(9Ekc$yfQ+{2~?Ov`1SCHYcw}u=o|{_+f%ilF;pEVq%ZOT z57-#EwokrT8EIGtmE7vt`>a*B~li6e==Crr)6>d78Q(TF%^H_3ej+U79-k)523o58lPvAGRv zfds2dT^!+(B{ z|DnGY=d%wYL6dtv<);s(nWRum2(K!0NkN*5J5ylUvJM)EN~{4L4B3K@cO~vZt zC<%*N6(!T--@iJI>lLb^CYWzjRMm z>ke!M_0w5?B(-s4MGzSkAJD{046v*Wc|loH*KuyRJXtKj#&dDQ++pRcuq&Udv~Ryr z7_VKKd1`%l?pt&=sW$oou1+j~+8)d3Vnx83k&FqWUEox-ieCNX-EjHLxY0x7={TX; z6m;2rP%UB_o_I-oDps{uP&t{aa>s`->F~DUL+KVoDh{Po>AwlB%+I5W6IJLxN%{*BHaq=Cr(1X3?j7Oq{1Py|_F>{{`(Ec%2)kc>Uu> zA10ExY{N~M)nf+0spXvn2O2Z!`AiAX*t9UkJ>Y>JVF*c=Jw%mub$N%$gTv6O`c;YU z@J?g%0O$SsB{>G5%aax%1DM25Able&pHeA+kAn5Qq;~lOw2yx!RP!^5PhiZVGSTv~ zyo*Yh`5sU@&_Tk)m;jmrmRy&`Q<4swgAoq--=Rqi=FDALb#HFGIn1fPv1QTU+*{U6 z9ncak*RAdiibNErvmz-|L`!b)II>)e2|^r3k<7RW=eDHAz!J{g&b>q0Ac76KzjqDV z0&_OXG5|#5`q{JukJaeN%>3|}(o>~DWb*C0u<+zw{fbyyZ>z#VeIX8;2%>^tSAJ3! zj5!9G3eQ%*{Z+lh0Re)|gxAQr9MsX7sTL&;2wxhkC>p&ZC-5T54borL43wzVr$O@J z88|2zl{Txmr$0hd#PI1Z9uv)e1^Tv_X8;!+Sw68{QXtpHa*OQ^QSgsLlQ--S*yK1XOfpce-!GQNZLKDG!AnNkQfJX`9&`O%+?QnNaZRT zut+G#$?M)K`|ukQHs$R`n#!DwG<)gQ2b6LE)wI1Q)`*(Vw+fJ<9t|Xo-(zny6J<(d zQ-{JE^ntWTSAI|?NokJna0AKNs$Rz@oe*>a2B;CLTD}Dz)SZ@2hM}1Knl9jdlD41>T{0;q zeb@s2J!ldHAlTmW>KC;cE}jOq!-1I#jd9&8B#+d6S7S|Gb_Nza9DI-IFO?z)t;q=o z0%3&K?tgd*r&=cm^0CHEAB4v%Iq7P3pN}5?0N+>?^d8AD4p9pq$KDMq>yrZMzy>hx zCMt56pkV6#7M}oMgh1(qs!E=79$0Pj0a=D}AJtXyH69B>6V5fo%X4PboPWkGo2ZJxTVgGn>0J)(&)R!v z`Ihqs{O8P0moqzL>D&Nrxjdq{$Ln=}*&NW>qmrdZhwdSn-S4ItM%A4YF!WaJdH&); zE=KR7&C9Uqu_ZiWO4 z<LlBO)&`$1tq>Uf>2h(``MK5V^G&@ zs$5>aU~fPD5o!V}tol>kvoreLx8Kn39&3rVs?6ZjK$&h)96%au_aqJ2lOIxMMIj10 z*$X*@wYr`@agjJV5Cazq?uKyP1D!+AHD;>JWkOB&J<$Pm$h3#V8YtV6?wk?gFI(z4 zOwo3r<7-kD$5*!V^~>&+=r5r5bFl8rBbW_KR#ad;W)vco8R!FC_<_1X&{I})>z$bb z#VZu0aTqn(hL7trrjK_I)W7PDBr zQ&7gZSc&pac`XM`s#61F4fj4#+@&E}M-gd}UJYC~hPZCQ;h>`roIEk>s)pMWqhd-9 zTFt|E8^x%A2kA4jfP)OUWzK|Qd#=FO@azc3$MY@fZ2&21kM7a<1n-azqo+nq`%n|T zfvLmfK+#L2N{2Gs9`}BzFcNE(Bg+sO6?^B6jmQK{fSDj{D4@ad(x2jn3`V$A+l7SC zH*z`D&=R%78*qDN#kCi)+}&jfr{tGm5KPs?L<}ok_xV~4a3-=kxd~D{t}HYqfHGln z8H{r7d=ds6-7xY5CWx5A^dV|=bcGS)@?CF+dH##}d?0mIh1(n}WAF!hqh>20jFvaR z%vn+Y2MP)Mb&3HaZdBHBuE3byI2PbCc4S}+Z4$F}6%EDz+6K863^7*Ykg!`LUEZ9v zV6R8nRuM*lsg`Od2g-~j1WxLXgfBpr8ov9eH)go)^t^?X_fo8P!(rc{Xa?U9sLfPI z0v#Z3p-lD*MW1;qArHBh3|ElOG6BV!A7U5m%LWAcf;21A&U-zlFy5OyaTDS%QGU>e zAV0#e3~Y&k@S~EGL-T963h^OeFqpN1ip-UVKKffVI*oSnNq1b2fp%ZMph={s#-R32 zZU-&6feCy^WB|dn^lusqYlU#7W3mlUePH0wj8XYIrN)^tt6xR9A|%2}Xm&v>m|Q;8 zcP(7ZC(|q-cbW#u@wl2dQ##lNwK&~(w_+zBn2P$%gZsN!StGDU(tNNV;ziVhgl*^! z)1g8k6g(9@cc7sTMhY3?9I3}!GH53A0u#)34(58w=PIdw3O>i=0%SsL&#K{k1W!;J z50^@+4pE{b)tOdCXj@2J71_8sQpsIC?Y*ZWP!22#lAY2o1^Ona5cL%x({Y;^_^Tdu zmf?J6hFBD#LZK#r13-NkjthPSLgGF1d_^ybixK&#v2Hy@@2xPqw2)u6BXql>T<6qN zA8=2aQx)h5l(Kfm2twau{^Ck$&jPvAI^?1PTx&uuP$dN1W@~EY9uu6 zd(@5r?Db#(kO3U@|^Wkklef(YM?({qiA76%-& z^GyRTxF~_40p5a8%$nkc)m)cI@KHJksf&i^Igg1Ak~m!4FB$bpzE&1k65gkcLy68h zz9mMUpP?=uSSAx_XbR4xh|bEBH{~`@2N-?@DNmd#-gCJ|$AfPgnDwI_3R}FdfId3Cip~P?Z z$cRWT5M$AoLWu`}^KckcrO0Sb@6jLyljYQ!B6GM{IrNL}k8c8d%?%^kK-Q`FfLSKx z$h&3~&npl_5%6dyoyegpG7uWAp=8kqd#O5NO*6qkeT+7og?_kq#~fCt7_dn(sBV!? zCS$9u>vk$zB_>pXD#59L$+g9F&yD4LQ zv?+TKJk%Xvcms_c3_wumVi4$;U<|nu$%jJ4AWqBmhjots_i-DVxo9WEg4`$Km|}~? z@m?@^Vqpy9H>Vt}|nQFhasXRDO$(r&0nU?VH8J!weTpM9h= ziF}}IXM7YL0^VH@|M$=S*Z)MtQ`wQ&Q7aLr_a}dO5?9S%>497{&n*8!BlXXkzQ^A7 zMxre<>1htdiBj+7BY!hls{15UUf z-5}uf-!UJ*#7+F<=KfUsfBF2WcKsa%Uy(ubgqQj<0sEB%j~>1J?8WRnFYo8*H~*a` zj{bNBOxbQftoAux-o&g90#L zW^n&@<^xf+1edBf ztD|1TaOw~N1hWmC?mHXXh@=4A`~v;U)*~)1KVyE}azeH?z?V;0B)V7qt3Kv%qgq-N za4mgGIKd=3o>16ta}ZyqWHOm+i&Ov91$>))v^B#a3q)<1snH3+^>#x6=&3>obUd>%k=lJFP_&yzaC3*;AiY#)7+EA~V<5Jp%x*A1Lal-G02e8A) zQMBaR_?ja3eogm4tpf5%H9_u;8SyO*5C?mt6paPTiPSA*by~yu+qtI(I}Gf1HK?!h z;I@qh{u79{xl1s?m zbbj1|+f;dSD|mu$7yxRwCUH_$n_zBcLz&Dxpn9)$MH5cXc*zgHK0Z1A_C(JO|9`G* zQV&>z%6?g*4j|T$;VA}M_&XcyaF2$}T-&r7slEAk(*`XdEKF&t9<({pc}Fc91bC{q zvaXozjrY7b{oXF=$z3-=gE98$hiyh^}S&Y zhX!kU7?&BRVyfEQq&FU&MlMYNRQ31K(L(>=?!k zWf__+^UPeUkxpy`;(so#0a0Xc7KXMQ!Oa354p)^e>)7_ZF%DD18}gis8>&6|YTpny zF$6*e5$_6D_Lq7UT*By|VSbic#!!LgV!4xxFBGARSFj-!D1x82S#nEW$dkC;@EZaJ z766(Vg6A^|qS#%Qvgg|9=C0_X*l1ePviwaewdxJ>H(ngS{QGeJ+wi5!LpO$}YfUJQ z<~-7__QF#vz-MObeO!6rCbeQ=sQPUWbJ-RlAfvgBL(*1*ORX!KREQwV^R%qF($*SH z3}Bj23h+9>zoakSXzC60@~YN%YhY2<9_$fcDOBMbKtR~Q+Vq!sD9RW9vf!KB4-FaV zd(+PRB>KIx!8eU`F6|91nnS^6bc2?zzD8^hP$6<1G0p~?*#S&W(lO>Gai;@*()rQc z@}h8t@8Rj4eEYTiK8}F|tCllIFkyW*T0{>^FyN#>9N=4n)cZd37Uh_|nduZf4t~`6R$mI}ED1u0aepjFaPyh%-?7TTnw3jR6&jd%Zn@!N@u zX%D(Eo5{?Zw{K=wk`A$|sttEzby_~Z4<@i&SMAV)I;{wIqOtDT&lTehb)ymgL-q@N zx8B3gFUi%{9R7P|S;-Ol%uh&f1OoV8RBEnVPq59kPzH0ZM->1Q!*ms?t5YmOgHtrn z90+gV=&&NI~{<(g{eSm zsi~GI9oRW3u_f4y{eeu0nyF^SSrGqAN6&hxd1t6i(K|Bs?B5tVBYyOZrcoZ^7n zbSnJ>e + + {4B24F7C2-9744-436B-9B23-4088395571E2} + 19.0 + FMX + True + Debug + Win32 + 32787 + Application + Router4DelphiDemo.dpr + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + true + true + true + true + true + true + true + true + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\delphi_PROJECTICNS.icns + Router4DelphiDemo + + + DBXSqliteDriver;RESTComponents;DBXInterBaseDriver;emsclientfiredac;tethering;DataSnapFireDAC;bindcompfmx;fmx;FireDACIBDriver;FireDACDBXDriver;dbexpress;IndyCore;dsnap;emsclient;DataSnapCommon;FireDACCommon;RESTBackendComponents;soapserver;bindengine;CloudService;FireDACCommonDriver;DataSnapClient;inet;IndyIPCommon;bindcompdbx;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;FireDACSqliteDriver;soaprtl;DbxCommonDriver;xmlrtl;soapmidas;DataSnapNativeClient;FireDACDSDriver;rtl;DbxClientDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + DBXSqliteDriver;RESTComponents;DBXInterBaseDriver;emsclientfiredac;tethering;DataSnapFireDAC;bindcompfmx;fmx;FireDACIBDriver;FireDACDBXDriver;dbexpress;IndyCore;dsnap;emsclient;DataSnapCommon;FireDACCommon;RESTBackendComponents;soapserver;bindengine;CloudService;FireDACCommonDriver;DataSnapClient;inet;IndyIPCommon;bindcompdbx;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;FireDACSqliteDriver;soaprtl;DbxCommonDriver;xmlrtl;soapmidas;DataSnapNativeClient;FireDACDSDriver;rtl;DbxClientDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + DBXSqliteDriver;RESTComponents;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;bindcompvclsmp;emsclientfiredac;tethering;svnui;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;DBXOracleDriver;inetdb;emsedge;fmx;FireDACIBDriver;fmxdae;vcledge;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;emsclient;DataSnapCommon;IWBootstrapD104;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;Intraweb_15_D10_4;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;TBGWebCharts;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;soaprtl;DbxCommonDriver;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;IWBootstrap4D104;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DBXSqliteDriver;RESTComponents;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;bindcompvclsmp;emsclientfiredac;tethering;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;DBXOracleDriver;inetdb;emsedge;fmx;FireDACIBDriver;fmxdae;vcledge;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;emsclient;DataSnapCommon;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;soaprtl;DbxCommonDriver;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + true + PerMonitorV2 + true + 1033 + + + true + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + PerMonitorV2 + + + + MainSource + + +
ViewPrincipal
+ fmx + + +
MainLayout
+ fmx + + +
ComponentSideBar
+ fmx + + + +
PageIndex
+ fmx + + +
PageCadastros
+ fmx + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Application + + + + Router4DelphiDemo.dpr + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + True + True + False + False + False + False + False + True + True + + + + + true + + + + + true + + + + + true + + + + + Router4DelphiDemo.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 1 + + + classes + 1 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + 12 + + + + + diff --git a/sample/Demo/Router4DelphiDemo.dproj.local b/sample/Demo/Router4DelphiDemo.dproj.local new file mode 100644 index 0000000..c4526c0 --- /dev/null +++ b/sample/Demo/Router4DelphiDemo.dproj.local @@ -0,0 +1,28 @@ + + + + 2020/07/13 22:40:47.000.564,=C:\Users\thuli\Documents\Embarcadero\Studio\Projects\Unit2.pas + 2020/07/13 22:41:12.000.007,C:\Users\thuli\Documents\Embarcadero\Studio\Projects\Unit2.pas=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Router4DelphiDemo.pas + 2020/07/13 22:41:12.000.007,C:\Users\thuli\Documents\Embarcadero\Studio\Projects\Unit2.fmx=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Router4DelphiDemo.fmx + 2020/07/13 22:41:42.000.814,D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Router4DelphiDemo.pas=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Router4DelphiDemo.View.Principal.pas + 2020/07/13 22:41:42.000.814,D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Router4DelphiDemo.fmx=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Router4DelphiDemo.View.Principal.fmx + 2020/07/13 22:41:54.000.760,D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Router4DelphiDemo.View.Principal.pas=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Views\Router4DelphiDemo.View.Principal.pas + 2020/07/13 22:41:54.000.760,D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Router4DelphiDemo.View.Principal.fmx=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Views\Router4DelphiDemo.View.Principal.fmx + 2020/07/13 22:42:04.000.058,C:\Users\thuli\Documents\Embarcadero\Studio\Projects\Project2.dproj=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Router4DelphiDemo.dproj + 2020/07/13 22:42:27.000.848,=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit3.pas + 2020/07/13 22:42:53.000.920,D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit3.fmx=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Views\Layouts\Router4DelphiDemo.Views.Layouts.Main.fmx + 2020/07/13 22:42:53.000.920,D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit3.pas=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Views\Layouts\Router4DelphiDemo.Views.Layouts.Main.pas + 2020/07/13 22:44:45.000.704,=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit4.pas + 2020/07/13 22:45:07.000.515,D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit4.fmx=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Views\Components\Router4DelphiDemo.View.Components.Sidebar.fmx + 2020/07/13 22:45:07.000.515,D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit4.pas=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Views\Components\Router4DelphiDemo.View.Components.Sidebar.pas + 2020/07/13 22:47:11.000.672,=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit2.pas + 2020/07/13 22:47:40.000.630,D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit2.pas=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Views\Routers\Router4DelphiDemo.View.Router.pas + 2020/07/13 22:49:19.000.504,=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit5.pas + 2020/07/13 22:50:07.000.641,=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit5.pas + 2020/07/13 22:50:27.000.287,D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit5.fmx=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Views\Pages\Router4DelphiDemo.View.Pages.Index.fmx + 2020/07/13 22:50:27.000.287,D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit5.pas=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Views\Pages\Router4DelphiDemo.View.Pages.Index.pas + 2020/07/13 23:17:06.000.185,=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit2.pas + 2020/07/13 23:17:48.000.792,D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit2.pas=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Views\Pages\Router4DelphiDemo.View.Pages.Cadastros.pas + 2020/07/13 23:17:48.000.792,D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Unit2.fmx=D:\Projetos\Frameworks\Router4Delphi\sample\Demo\Views\Pages\Router4DelphiDemo.View.Pages.Cadastros.fmx + + diff --git a/sample/Demo/Router4DelphiDemo.identcache b/sample/Demo/Router4DelphiDemo.identcache new file mode 100644 index 0000000000000000000000000000000000000000..134916d88d3a362df210ef67081fdc4c26b97551 GIT binary patch literal 1859 zcmc&!!EVz)5KT!OJ4suW{sMPPtvGQ5hg6YT5hZQ~!Us0aG;FbVS3B#LaE9;TFW^tO z@H5P=V}}G%sX0InR(8jpH*emX@f(fC+y1j;q~#45iOE2-9PXt4fXP@E2K3WDWa>Rn zkmV|aqz}1Ft~lIn#O-}(@57PiBISx@p<+ns>tDJf&WO!nJDLrKLotJo4)5FX&(Cju z?41&7aK$ud!eD!{Km&P)3*vLlQs~4LH!sZ?Vyh6`1ZSEN(G>l2wjk=*9s{M-&0D6I zS10=;4G6+8!=>oPwlW9pxo4+72ayy;%M4o=jEnX;n?iPS$ZZGn`tvg|FUxZ`9$dVB zHNAny@Av@dahRi@x3%W!zQI| z#}2(atjJ@_P|m%v=T!6@KyY1%)N*R8Vw&-^RZz-cVrG%i89uI1ofE9mJ|(q13aW?~ zTl|(y=_}1|nE`JKbK*V*EHcxJZ6nH$n$*_$j$T+wv+m8>dl)X`p+(#D-{8TR6}y^u zI8(av^Aq~BbXIR-m^POxl4?=8rxURmLoxv#SW)WJVQiaJ56MxjQ8$PC|1-cHy7E$zO8#-5#azR)xLs!CEohx)|(68c0N^sx`wS zF8;JZlP270-W(UA_gpEmj&p94#>6j?Q9iis&X~!nmMvZvYw@smL-Y$^1Cg!( literal 0 HcmV?d00001 diff --git a/sample/Demo/Router4DelphiDemo.res b/sample/Demo/Router4DelphiDemo.res new file mode 100644 index 0000000000000000000000000000000000000000..40531bb73c0de6f884d5d552c9710c1caa4a1198 GIT binary patch literal 112160 zcmeGl2Rv0@_}WpaXlRIrl#(qgRLY2wXqPP-$ciFVTC{|UN|8eUcG33I`uA^AS`qOAp&V>@%12$ zJ7G)3;|lnkAgwbs8#DOj2~X_doic&(77(t4BgDYp3#oa?6Yc15O`*nhr^BH@42PU) zKoC|$e~51i7+rv7H^Lh57y>@LY~k5Lh>N&w;EfwRu_o-OI9=d5EA;45dHagr4yd;U z`X^9xv1gelWhzhgaWv$tAz#P=7ibx&rb+gjCJ166Rg30Sj-5f?3m_)FtOa>r@qUyd z2uZ+0l00?x)VcFFds=HcLBFF=FCmE1(a=E8?5kC95$*Wl$t<^c2ZE3~VW>CC-22JL zr;EL%>>rnX`FwMT`gI4d9@ax<4sNeDZ2U~Shz%X*^fu};wrkK-zfqgE_P6N5)$PjF zJAPgE3K?wS<4rIdtD$+n{VcD&vYG7{T({e@L$$EdcEW?s=@Z;;pU&Np75!c)YR5pO zQsZrvT7@?YvpNlq3p1Nnq_CIAG<+-h{;45_dq%(%E8o0A1zn|0+#&(fE5iGC=AOR$ zcu|`0KU@#E!~>!=ih}v_Y$u1u3GNm?X|hAL`!-^MurY5EF^DHBLi=jC_KdZ|%ZlU| zhs*kvQD*G!I8AsMUw5ANORCPgeF%N{&>*_EMPCy_;Z5cQQF*>?{Kf)FJPWKuCUO63 zaBW&B&$9tW{4PY_d>Q#p)2w_xY2*^C%D^CBgtBZ7$5L3 zFgH+LZ>{x(*QfV*xEhHD49@ma<>_N(X*Drsaru|@MHbTqCbhQ~&R5Id@%prjp@7N^ zC+_%u*;f7qSbQsSnu zX}qSRE`0pJ>)TC@*Khyf6IUqJlv@hu{^0zFh?xM zDrSH z&&iyyJYJf#v+9)RZ9e^tsMPWUvUmI}HMX5f=e^r0+e?^df^@IY1MePk=ZNG8-EeqoR5Y7CxP21wH}5G>!rt=5OKSzZ388`bh~F7J8?t2e@<$e zMy{3lAR^nVgjgo%J6fZAxAujB5;J!#jrEW`shTJf;G)^xRn=AKN!C;euO6;vUY{l- zg!fJvXTqJoaISyOV#N|f$Qr+wCn0FnL?W)dESGElhE*>uy1DDP#(?UL z1k6l2`i%@f9d30GOtOM=vuTP8JE#C4;KCMhfauWN=q5@{74$2wo`lesXJh@UE|;?6=ypsaqEo$@}yR>r1-z485Zr~jReou*d8hC_J8K`|FUqu zGkCb)Cw%J&btRD8@y7CrP{a)G75?Ae=c zbm_h>?Q_(iaf)1PdAF?{JU!ldVwaP=4-5p-Cx56Jec@wOq~q9K@BV!)zu$T6jZ2FS zB1C$>p{tBr`EWpnJvFEzTMWt181G**U%7LK@8X&U@jtZ zJ#AOlzWl-)?hTBYR;}WjSuW_h%wloq4QuDqe6poAe371uve&gAlWK85aO>~^-j%bL z`?#3yc;DsR$Y|Gcp;S+CLM*TAz%6M9FTZu`k>BlxyL)<|ZV1}+HLk5w{PZIUy_L%} zFIMsK9=;V?8YOb;#Jz2x3UF@Zdh}>mUHQKE)@K4xM5(aPlUnc_*%IP>+%3>147_b8+_x`x$)UUr zDqQ!&UB8$Kb*f&Gy0dhW?`xG*U*Xu(r#H{w8yesjH)TNRhvny2&akXX{3NzTb%1Bl zL#LYe(M}igjLa<6#T0v{s!9}iD!uoT>@9jr@}FC>u5$gK9=h;xN4xtAyLFSIC>wsr z+w|yOzilZ2RkDjsPrdBBoG(~jv8Ta9&;8Fk#LVE%jxXLYe_4A|nWxqAX2I_7WOXmK z%bq#5=7Hw*Z115LGYeydFI6mC;=1nj>6F8-h37{SPZ9N-piCRH=d5zqMf(& zZhD_vGuyp)j?wRR>Ot~OL5O+_HN2n8GBKm({##q)M{D*eO^kW%GGg4$pdfA!FT>Rq zhZ6L}U#U#m!fQGsu5|ef@vvS`ZyrpNEUdJ=>-#Zoo94ugGkC7Vcuad;w$4Q}V|&NU z@fo6k^PrxEpPfea{rK=lizm)-J|D49Vi$Lwa@e5$8EY-ela$Us(M%ZI9%{0nZsCdN z_YF#yuIeP4T($P{9HrPVJjH3f9QlTqF5I8!vctlJxbU$LvBUJ1-(Z!lZ-nnTUU)7P zd0S0k$)2GzJ6&2=x-asiLc9%Dvco2+WKSCLeC8E%8N-TKFC8zu5xIFwTK`~RS>
  • 0EOjDNH0Mr_)Og&)(O7hNHiz090&#rg2i2(*%JvoB4|P+RSN;qWzYBI@<9=q+<)r9+x#Kt}9 zA^#yNGJTU}k4IxGhJ{HT8at}cCpBY!?43Agm5!n!g9dI9OGr1;ddG7tcaFiQb@LUj zt`8TEi|X_Nnu4n5RRsopGyMXWoGr8cN9|$k`}mg^l~-y+g*YaBvg1x460&cQqtjJK zr;CqVc|rtxTQ4}K@aD}Hg+U8fsV`CrS+CvS@5#JFc^@P?pZhe)cZu+{gNqzHPNS6e zba)zIjm>ZenIf^#;a!DR&d-bqHvK30bdip`n8>Pry!}>kS$D3P``?1p%m3QRU)^|V zoATz%`pH+b7A+OgoNz76OXkGocngb;dCJ?ftHL&nNijUN#Ke4_@v}5&8y*y7y?$Nu z!gVGgAyBeK``s!Vv9z;?9l761pLiz6+wXZ|#>$~n%sec4M~6gozj<9$Ve#Y5ua+&{ z{OHofM<*2YgL=<2-jlaqXYcz{lVgJnUXgQpb7eb-Z3$YHDOl#0H(<(g;{orw+_96N zan0&P(sJw0H!Tg8mF)DW{=D6zkGIcy1ounh|?i%4Wg-G9DX$X$CZ$;`;|E(M5Jpzjf)&8>0F>Lp_F}|5S3tn#RCk;m7B{?Hr7s~%Y z`KueGrkz-M`{l&g_hAxUE~FS~Bw8E#6?YCj>px65c(b!X&*1!sd)#W=2a66Q?isQ^ zE#0^#Li4TG2gh~pbHX;n`(AfU>(XI>a4gTpVI3dzzP|~pZxcOH|FA^iOBAuW*qq;X z5g%W3b!OZEnVB{z=M8+9=)8R!CTuTfRk^1s$8;vKlv^TPTP7oC^lo*Yp#G1K-fsb$6lMZsG=-Hs2BeIMffQdPiTckS%OgBDSw zUmodNzGuwz2@CE*J3OI%+D)CfdHaj@O8QsJdhA>>VYXCY5$QWL(nvN_=+WsSh248j z5G6!Xn3jl&QBVG>r;fgwn?35`^xW~5reh)=dCnE7{3P|Xhn3>WewAYk2?4{tL1tH{ z1y`+44z0d2HhoWr=@oAW#BASr%fM+`?ZozMx%Ls=WNw8Lx()kE}X5 z!cbpn;99>D%8sM9CvxI<>90QfZG!e1=!<_fD*D>Lb^|qeMi4t{E~uNfw;Gi8Zh+C14QV_2m1YJD_K*t~ zw%1*|b1@~$x|f}MsI~8z6qgQR#EG~2*Bv%rXH_nAEaj}8Mrfdv$iPlz1Fa`0a}{X@ zFW$|2WWU{IqmEa_?ioG5y>#$xpHUiNTvDCNcvsn1??18RqseENerejGx_LGJ0tt@c zy+rN>_y%VEb0bb5t3#hRNi%Jo$w`~$^PS*Ust7q4ZTYCnd2(v;?zrtQw%jo-yC#~x zx#*6v;iu#gdlpw@rOZeAeAL4XJPJaIke&==o|K{{(2)i^nV~UUo5gXIJ^zGDdO#If$(+*DCLA zGiz*oTu=9_6GA8Qs1BH+^@^ur9+xq<>eh8;3D4zcL=Mp^8F*2%{oXNoQ*BD0%D-AA z7g>~cGC+XwHmESf-Ux$$U|*-^W_lX=~94SPI)yY=*y zuA@(Duj8sDPVks!q}YX8eKA`e6dX4oZ;OIY`oAL-eWN^gde&5guUIM_aBJXz$%*}q zMW18}KJy;05qjZLl%n9Ju0xZmyTnuwlZKtYa5}-<+{nUg+F+5YN|QYK3cCebTg9h_o9h+1Bv~+Ii?+Iv#Y!iUb3O0r2ln!oAg&X4r*ccq>+Z;H+VP^n zpmyEm*4ih?+x`=jmOe~n$Y8+*_p8U=;gw(2cl)S>GZ6-z4|#7q;oHwyokhSjciKmiGkip(cFf^O?G`i?q&dKt_ zy^O^8kD3rCk~*)l@gw{;@Z9Cy-D`Yjk))I3_0#sp>z#V^snVF}d0jNd{7O(iYyH(8 zUH#_I3q8j-&2rQ3x!iXv{WGSen!2eU3XBU4T{_Xj-=?HE#;oI*Ptz+Y9c*7^ifI>) zi5{G>$wo~?e!`ML#K_5sU;e#tuVkXC!aMLzkPx`{?zNe&^%O z2gr92wOz68w(IA&VIQKW>5MfK4VY(a-7at7)l=TLT{~5KbvVs?WSOtW9o{3|KejVp z-@o1NI6m7;8$*0&T6FgESUx0zc=j0u<`}D=8(`)s+b-rm&E6qfH@v!3!1wkoF=m0- z?TY?_=Uup7sJo9&aO)N<7G=Cf$mO!}qqI?PlgB3!6~@HJqEjPG6L$p#^@pz13-!+N zu`7<8A1O1#Y$>0WeQA&P0}R9~t_&NgxB~IZCqEshu}(Yazysa6Tg~0x@m773Te5$5 z`0It^6TB783`Oo~%ZQJQUS9faqey^pd#jGsT71Mb8Sgn^i6J&!u5P^c$m{)Pmjgnn zQa9SY?k+I<3LzUHWj1Mug+e*^n}{e|=k9lc4#9v@N}5OZ#w_no6+25O5QT9uW{GC0 zzPm0D*Bsq{*YT$-7WXhxA-S}V*d!(q=9d&i2CW?_4rbn+mp8b(?ZC_LKA+1hY=3;C z%R5J1ixi=;A%da?z6<8&8B}yVG-u2y5A}gpL?{9g#-DZ)5%+Aj?Kbn2j*>chV}qEe zYOnI7L>S1cE$JY3uRCR4kzqiht##*3YB{3m)C8G+*oqq?$oKTw2tP7^$I+4Joxgnv$hM) z9Q7Dn%_}BybLZ;KU55(R+y*RjmqJADvaRMGM(bB@mNyiy7z_M#JLDUk^RYbCQ^@jj z^=L~$tKl;wOf#Ym4TFjeI^JiY9u<1CWaa0Bp&tm}(^!uNEPm@5z1uu1s9Y=IQl}sf z->IkM&d7CsQyALs+=I%XPEy1T_e`#dicqPC-msnUbor}(0!I4jDe`;Oa>s^*O)K=5 zI)9bWC5Q5il!KA+w_lY>^~jltLi z^XYEtHy7>;)p&6ueRGHSvaI$i4@?>Vj7+)vFt}POU~AyE;Rh1$`>%Z5C(m}{hT^k2 zx?j?y_Z|=(`H=d)oRT6HYcbDMeCI%~s8R0@2#nWP-0hk%Z{3}gm7ASHh5C)xNiOyq z1e6CCZBYnY7bF>=w|w963H+xwoa{G5ySUHAP4aaB{L(A-%boB zL=s$k~0OC&gv->)ByLt1KC*2#B;GOq&pu(*|e(wZb;G@KXMol;Zg1g(qVaos@|S%aSo(C!O}<i{C}-)LJ@!VEI`Vf%2pAI)xk+4PSje39ZmYOHe%z*MJiz_S;XQHFHDdY+KJ(d{ zI$)#qzgH^<<)`cF$cH_-yx6F3V6Q73c%D48c2)|%8GbzGiuQZGnpKZi9(ZUJLGqWK zeSMneP}#_^w>5#?g)B}w5X&^*Bu&0P%UuvEhPVN}j=@Zn(BiD%wDkVs|Lt5+P1!9- zDaZ<^#HQ=VjN6{%byGZ9+Wo17LUPtDjmTrK4o90DF+Nc=Lhn*}bk7f~S3S|*F6%RJ zURS{}sV5f>)IQzmmj8tg?*9$UTk~Ig|0_lX{-?!br=L6gV)zYrP5#O~djbERz0A0eXf5vOy0NHB0{??F z!Gx|RDP@8tJ$4PP{@^=p`Qjd%Qp#0B6ke3pkTz?!l>e6(b8b>ayg83dcfp5A)}Ky{ zlpQhK@Ll|2Lw)51<>XoJXFX&q(mu*XH(+u{yQdoR9nz&G^b0@C zSD5=@pm^GmZn@`lYi?KS);vuKR;>82Y6mgw&Mlr11`<2x5wmCCy|Cf(vZeR5DtkrV z)-qf|x%qEbp;yaBwlDC>%dH_c&e)~-%0~NjiFsCs9UU+G_lj5-eQ4OL!fl!+(tcUV zhRgEY)4N#ceX4leb(c@yOY_2o`EnB7mYw>C7nUFnjd#K>e5LMV1|BO{I=Gp=9`Fp6+Tw z#Ln!jm*G?3lWG%?c7LUUk5Z^a)F?M{qyB-S4HDAg_Qk?vvHzCpjA0>frYTo*In3NO zv*dpDbK$8Kz0-_h@9o_5(%Unt2+9TKRsPqVsvudiCAfA-BisaL~)gf`z#@Ic9kST*O8ZJ9nnp z4&2NwGVX-sy%7FmdqdMSyl$Dmtg-C^`M$R4`?gKqXXSjn+nXsft&F!TYYZ=&bF9ZK zy)-|C2`Yl5gU_cUSKo%%Q3^UzrtA8dWUL$Fo_WyeLXF$$cM4B?_{#{In25>BiXF7w ztu9*K`=!O=`9u6~h`%~?cF2UGU4kfN?@w|Y-;%1?UK9A14fW%Ps+cwp{A%uk1PwFa z8hee6T7x1_3{3u4-=%c=uF9b2H3bH%WoPpZi_qpVvY2_wQE;~OuAb|i*4()w!JX3Q zI{&yZ;Bj{QSp)sLhb78n?|;AYo?!Q3>t-JKqJ6_X8Y0LjK>5uP$7vmlS8g!!_PU?< z@JYo*X{lrDC=>P1Z0;hBjYCgsCB1}cLfmI=Yi+FZ>lA3;<>V>bm#R11b3;4^gh!t7 z5Kj{tXr!{L^Rc<)4wyf^oNz5=rnKuEDOK~$yrweR`L-9K+x424>+x~_ai7jaz0|n< zToF=R*o^5Gb#8&rr;(IuoBetTMld|zRU_*5@LAW{RmTog6xpl0TF0qQ$$Q5)SHxoA zq{Nzk-tT^2xqr*q@{;(+5-GtFIa;s)Wj@aqXXKu*@sBSbGHKq*)Yn7vs!B?)XBX=B z`CNYX)}EWoB~~PitB$ekENisee0IAxOFa615nne^yGL$tO1mBNe4O`$_CDy1HHM1o zl7qL`nGKj!Ryn|9S@l_7mkT^!&X;iwm&n^4eZf3#`JUIOllKI#OWby&I{USU_+lCB zC<%+g^>-wrpLOTfNw~V|!1UCjt{#&nbsO`%AlyUTUGZ^ye~DYmjQ79v{W9i$(c%A2 znxDkt>YJmV@#KQprAfXY3^gvebuC{i5%Q_@^$qV%Zyav8yBvIQ^}xu3c}6+oDM$7X zm9Y?nro`=djX_OfZ^;hwSCg(TuycuyAofpj7qBq#kH}p``9k?`-Y5Npz^>805w|aG z=ufUb5F>RqD)Qa)7XoS*3$o%evPNZO>O|xYCng*!Sr+zAcGl6*507>B7skI7e6wVd zoPSkR)zd>qv`RP3`@DD1+)D*nQStc%e_Vyd;7utt-Eo>F>*R=0sVmFOKZ~!M8hCHs z(byRgs^wfqG>_PJEKL} zHt_cqusIsCZeE`&b7#42ojvBuQR%=VedVg0_k&H3KIk>&-V29_+zW3rZ?C0foXk2r zZ`PH$(bE3K#a;XQ^>OoYblUKK;I2KVZWm-lMm#y}<2mMrI|)mgpC}3^pC!-hd?g^& zb|R9yZllhaZ8xl8X3E@1BsPOcaJ5tLZ7SU%~OudtsFW zY5>_=VtHpS+W0K(`1I7#T{^_P@$KK!=^Rd$YCGHV5T{s*@@nDi`;c zcvMLV1eFaHH*h&xeIQ(e?=zS7lyLF4nk1!Y`Jpfi%0+nFPu#%Lrh4jdslc;=PxsnR znkV*5KzQx@E1gti+9}S0A~+yXy6l9l9zZtwYP>?SrkO?Xwx@;`>EoR(*46l2wkVdS5pIZ46ntQ>+IsIxlu4{ zqQ<5@>pZ2c{9#dmFMmv)TG+ei&N)$wdOjav?s<>6}pe-A&(NU5c{7|&e_l_S~7cvyKpT5 zmjO%gafpJ&+}Nvqa$XiM`!a^-1hE7fROOr=x=*LBH9zXvEq}!f*{n$mJBAauOrh+` zCvTzAJ;T&D$K!^(+*aYep}mH45oJlod%7y*+viO)ALGrXmJ~6x^ONJjYwr z;RxjI`MwjSlhnMDhoi?(X>#a%lHa3?h{c9-%Jqm`)uQ~uGyX#IVmI6^xwSj)XzyWo zE%sfiCuP_AWnV50cH}C8`oTCS+5AA(w#3CQqMk+778;voIF)tRofwgOyI(J*e4ZGa zjz(Nv1E*8^#^$|PJ?R0+DtYI^H5%|rCg_!26Wu} za#A-7$w;|^@djglX9XQzid8rgFBh0$HOrebDScH{~#~Bn9Sv| z0Sh57iTu9uy-(dN$eJ3rA_4p=R$WXM4|d%5d~upOfBGEhUT2oZzCInicSQm?W1#DZ z-u( zF(a$Tn&A~a0+NT_ku?%fed5HuW=OWzRbnRhy)_lW`*>#ZYzh35{-rp!{WK%~gZ}Aa02ve#$&1-JbdB7FGGl9_cl0 zl=A*%3i;#m3d zaN{Bj$4<~YG}>x8{2bhli_RYmoDJck_Xisc;Q)L{_4AX&UvNR-@AX##f4BsO^eW&2 z=n9|+U^cW*!9pde!gZRmg}X;77abX=UX)@uvgkh}?V{V`wTtc;jV!vMuThjbMz!dq zmR#Xp73soFvV9BOA?-8(b%34#Jb$>@ep~iHUt$0z06_pr0674a03?T?8t~)-TmaYz zU;!Wr@V7$!304DgZx3Jyuo)m7fRnmr)n?EpG68k~m;rS838H8-S%Q2~=aT{c0muhn zRZl-EUJ1~IbD1fh>a}LR)EuaCJ2>?t7 zxDLRsE`E0Ud%(k7fc9-cckJ*8G7GWrwKf=u`U>;aww za9Zxa8oqbHqbC6F)ob$?$Uz?f>&RbCPpwT)Ht;+ZpiPb;fp2kuLjbKU=U*K^&M6FO zD-{9o$_;>R{I58M`&qV93i9v;z}?z^>;?Sw0XPHjv*i4%=X(QWgG)Dm+y#710KmS_ zudaiiO%h?d+W%c0%SYmSF{13OT9U|R~uSHE_Ev-ecgXPARXQ=rKFo_$#Gi?C!?*x$1fG(Eo z;CI%4L&GR5Bgw0&RnVT5l3H>_KeArHa`#i_2OwWu$2r;(-D8?RN&ocrP*hk$9!{tr zr;abC_8VF%pJt@H4RL??JR#)i-wYbRs}ufI{nyz-4N3lYwTiT#QSu||gXkaG4uIbE z0IL4#zfRjsf84xYMb0(@JAiQnJ2Gn`?bk!hTiFnRh8_TKnxLggKL7ag-@qbjpgu@C zT1o1SC?Z>F99aZ9k!el!1AYSFFuS_P^leT5G;{cpUqkvYE+Z9NXY7dUMXlyT0=Q>$ zLicT1|1>)|f4Y(!DPPoNJ=p?z`?p3N0CaQ%c;5ng8s)LAmVcW5@&5W%4LQZAnA7b6 z&JA(A9RQrsoYFnw`K$l0mQY+wlCBP=)cHgX%9jGTIObOjxNvSC_d7OPmRs`tul~Q) z1US#UVkyV_1RPl>0^Q;~&$X85m|2>?`v0bX+OOc{9JK-5OT+fO5a2LprpK1P`>TJN z*6ZJw`+yC=+EPp9+92IxcKU*V3w<|RG{4_~j_>&StN;3Xr-iDZEm&Yv%Beo#2hc-{ z_ZvdmX-(;|rSCbZ{}1nLU_Gwo@FJ&%eDk`7%>P_NmY35s@$>G51vR9pUh#KjriHRz z+LAf|^1^oiP7CvFl6Fq&f0*B=3Tu$fvy9*VCZ zv26aR3-jZUkBMV*>j02va%;$xhVysOKaEz}9d&_ocEKykNjR$ehnT@a+Y(OrmD~p& zSU!gY;z|LqwZ2D_8Ke8}sDBzSSTCr_6p@?PmXo;N-)a>9SavZ*=% zc!_9Dz0+|2Y5GULuwUS0**Z2*0rL_Zr~^(i(?9Tlb^i;Rj#~5nC+Z*Ng*LEgZfUEu z1+hD!AHd$+FrHD_nUM{^JC)YdIX&(_RsYB%`u1#E!}*Cs^c~WWWxF3>#zg;1>2=ha zzyDFPxnpK%a7)lcdS9 z1@|YA<~!dIc!pf#;AS~(ThKrD1=hiuJ|{2SGlzD?hMv%mr*FeL0G^Ft181}8 zX$$&CdE%PVs~4Qz=(^0al-)L9awGc3Gx?gW$CjpPEBeQ_difI0)&XaeE7@%WLK@Nk z?w0DZCF$CV{!upSaMr=6kDTiVynk22ZaF>Ii2m{HL3Z)7oW3pTAIF3HcUN$-8$eDR z!CH-T$nq^wTQT;D=E@io_HBzptLFYYabpZUvb6J1r z`HXE%|0>WA$a~AVHegQ_dvk%Hb5%P1qklg;_SEdOZB74phEVb`&K-Di@f>^e0HA*h zI{mkbk2f=$YHRw(allI0v1((=SvI|FL0&lAHI+HL&tt-7i~@d$n%T|u-S`4 z7oJOna|_JM7_)a^kLzjr2Rtj7#chpuZBhSto*er3bKi-s;1;(k1Q~Ed7DLTLjoi+zYo76w} zZQQ%VIsM}qlg*JieO&tbf1G+z4E?(w@w+YRANzmVu&k)@`a&4Lg(~( zv_<_R{~teaZu|%3w#DTi#(&3Y?LW)~`O)j6Yq>e*Q}*En^d4+yR)v{e4eQiXLsK(H1xv88xgnyxMC-yhDY;MA3o4(mT` z_yNRb>yJ&0r zM<1}~&p6lj$8XV~e|b}KX7nC(u0reo!EYXjhv&q!7+-VKwl)3ZSPjnr=hU^(mM#CU zD$sd1n*Q+)`n%Lz9kLU@E$JW2=@vL2fKwNKe+bW=U_<^dK>zjj00FM8Y~X7)Ep18v zxM%kn2iN^xAfP|NhQ3xeqJKFy@HLy3 zwo?AFkN)pv&dvE_8{%TmR@;xdn%Ic``QbU97usxHwj@nk(ZB69&X#>VFP@!wKhPDP z>(;BG{%hNSlP%F@OVYFj{bRomza7fS>m2U=V`JP8y2@xw_qFhlIBm>Klb@r z;|vh|{%lL+O_yd16a5dRi^pz0Ow<3#`p0?snG;J$JhO?DS1z1U%>n%wG0{Js`Hbg7 za3UY3IR0e)2xt@@s3OPPp$d@7Qzk~j_(KzsG@kYAN8HI`~AB#=6C%<>X>=saq)-yQ6}{^EL~)L zMdk0W{=exT>wGNt9MnC^cr2^>WhEZqTmM)8-*m>QU$~D8$N22{@;9QF1FYz@IdLEl zVF2t;aHM|vTmDHB_i*8w5p5osL$b{WJbjv@TUO%&UXG0i+p_*~AIM(#mJ>VY_c5`R zW`FCKRsCZ;$ae>myjiXr+N%Cvy{IAQ&MINof18n7NURjL`_^}tK8gUP?ASnC(La8#=lH=&>bDy?+`p&k z9q)K{yD>XDZEjk~&*`uJ8IJ<+o4rR8E2!UTz;l1tkrfMRgPN;9PQ(YgqFA7u_*?1$B)W$MGB< z%QKTL`sp?KP4DLFwK?%2|E>U!nd!Q*cfYg#@tcmsIW$H`HxY;R2AcMoVRzX{^~er> zpic^*S#7~zdts@(V4eR9wmh{R>UHBSgDc4ZWzj7Gp#c=`UuMMzm z0}nuklE1R98PNuGw*%Pz*9KZ_1IIyjKXrW1NVm;-4m>yll>D^=mhAw~XbAxLDf4>G z(JiZSffogUX3rBr8dloJKPe85q4imn>+ci~_`-vdzhE%x74pDm>uc*irR zk^tC|L?E|506qXX56Vc+ zzuNO`pmi0%pcb(FH%TKB09oR>WU2soKH;x8kA!=p!U1#u{?_r0=#W#7K)z@TxF>ZH z0FE7g*tzA97p<O4#2pO#tdKtKrev5W&3wCfWP#zB!R|!U*R+)f{>tp69BmA!tlCY1PX?E zzD2+wLHN@iP@~f&$f3R_1ZeLAzJ|GI;jh6u1XZ-K&esU}v~Z`d;T&4H79oWeuBC_; ztYx9*Ti72F)S)K`9Sqk}i?JjyT$dd|P&3T=mY$j+$ZkQ{eKEA)0N4a;l&@(txVfL;Jl-YN9qhV=u4bLihg{Zfy?hGD26 z>oEuwXg!8>NU|Qm4a5Fq{R#(y^aNAuQ#yjF^(`HN)cTl?Kx%zWN00>Kqa#QM!*m4s zW0)>OYVezcsM*m;gqj^4#}Z%T*JYsdHC(5X+8_-fl^c9k%Rw!=ItnFd@oN#(1-~Mw zr3Rl;S(Nzp9$Bcvj*o#P9lFLK6W0EYmY zLvw4y#eL-cexwi}KMR0QzX0zvdE)*m%hr|w$AqT+Q0RY=1 zT3)~E{UXpP!buqbzRm!@laCA5$K5$01HglN$9ehh^zG|jMxH-i$u^uhSxFu}P(eMn z9lx344BzL#@1(Q2Pa9>xmK{KPUI1LD`i^&ewlkvjJ|2T-&Ec722jVJ7C(DwSo;jBa zbhfxYfV3fucyDd~>4rMgpKo*Fe3p=MQdg=v%3u;R0RT_v$N1mx z#6QXauhsr#Ov`F5PmkcvaNG#*j9BFzsX8HUMc;SV&(dXIA*9oU5#h&kAlV%d^dj$wLVh&HfHCe&Yzgh0{bn zci{bZb13i({rQ=;cMb8j2LJSV;5U6xe$Bb?>^>Ii!|%>xfPB}|=grFR*5)5+Kwj3b zDr5P~B|MvHs&R2sHn5$(3_w0u@8S1`no3vi{g2?ECWAnqGHPAViY=TzQQ4FY;Cy0T zJqW*tHJ5jc|D*WFywDD?j%4M+@6Q>)Sx8Orq)D>@i09Ho+(vQzNdA#N?DMkv-Np@2 zW}4t>86E%eO~h>!*N^5OY4m_^jj(dv{;!HuhBFPB@Rdx*{}U$h7~=RD{3D&OUpC!G z!0)nX4rf{ha%x~L<{v)ohF^$LQ{m-)hQOZRuwT0U@l{4iF>QiG_hn>iXzowr5EdH@A z#CedWu6?^JnDRe%MA2-MQAJam;*-()pT$3(X_))EY5xD&$DDs$dk6lfFygPN=RcMI zH=N-g#!Dtm@yY1@&*GnI{{>C+AGeFS{?Y#B`W2`%;;*UaKa2lSFb9nDK22TWaLz9? z9-#gk5AB~MvpCG&{Ve|NXRy}(`MNjV{sI5|z+*WxJ{i6HS^RI?%v%3vrYX~LF!q0_ z>qEfb14cYDd;T-{$Fh%e-%VZk-4gs}2^0F?0RPk>0L0nLBpyQ?KZAc(ZU5RO82^B* znDBLyZu~QkNj!!)el-8c&+Qv9(aFNa!hG;jI{u}92mV+2!GZ@17p{x2@Ezt6bo>** zf3x?d{z(0!-Iudg?NQg#o3Q;{;J4lxbr4?BTpRci{39QW=9ZGBtTlNgez(UI&H`_O zmn}5i)9w&o3ZPm04qKaloXbz#TftIahgK}8V;<)99?C|U#y9;Po}UJ2N_KVcIn6)K zW@kaW9T#0e78SD4$)hn2cbpf}u08*q2_NXkL(g{IZ+Nc9BwZcfv^cErpPf}rZrxZ; zZiTTpBiI>HPSrEES)V>Ok7pYD_}v3bI18Uf8wYt1{3 z1)A#X*2)8Yf|#D?0q=1<#L_z0ufRX9_pDe_)>L1IW*01-PYL`-1JKeiy#H+ei;8MU zR|n=}96CM@HZXUFK}aJC(4_zR&*VS-P8BQd98Gs0fuCLs8E)hS#McL4+8+K4{_(rZ zE0&fu*B{Qj5f+<#1pEgA&}8`C{YUcuG_#uOveSZfcTI1`z-s?rS)}0541P z|1GWeaSiifMm33R9q121>l-klg~4<5jjvnhWxyuW$B-V^ht4*J-*bK`c?A4c*#hua zz;BRYe?HvJs<1>5* z(5|_7*@+MRbIR8f320{xz&Q-m6Ac1t&mutV{`fJGtkbN@vl8xL8taq2Z`D{?Od2nIn-o?K!ZE&oRGSE071QI=dm!le~rb#{{gkQ zYVVBl<)VCzS4VG7ZMgO>K)ctTcG0PUJS1pxYA8RNTabJQxSq5sE8!K>4};E zw2KL-XG%bh)N?gxdM0yF&GAz7=SY0*IyF2;LLPFm0;oGjVju)s>4LJ(10W7#AARt1 znX56Z&>!}E1p|b@*f#*4Il((ah$8{e>U}*{*aSLoe1v{f(E!;1th9mHmc0Oo1(*!b zDt&fl^h2J#09FIwc@ylmRoDl`{et4m^5n!j$OFGYu?CQG{2Z)dJ1^+a} zi|ZBaT8J67d+?6_Q$dblZeLiYCo*FI-gf}V0-*6+@7`MU)A)D;zO}O^ zG4&yM1++12AK=|`MzrJe)}|l%C@!v{)(=eR*w~m3AbvLh+%H{E=Ja7^^nd(NLq2|3 z{T<*w&{r?2sdUlg+|<1gd|ao)x83RUru$t6zrX8iz_S3lIE|)dMnA5_<61*wfOxg! z3P~&T66#qMtoWekJgugtVL;P*dL2L<0RXhEM(L(KZ;F0eyr%BxUve1MADZ%|jo!}C zj~4rUb^TWOZO~Mn_?}br)ACve`-^cMoY7TMQbU5TJ0qFa`9lD{tu&m>?wqC{^NQTU z+_@_%jG+!<(1rj9wzVwHIkg7;aHb#m_yJ=jynJ3wVw^_g`W&9|0(1vxw7qJWrZwot zJet~DHwF4m4QYWej^p}5eKE3;ca6p8xc$@eg|RaE@jYYzq2N_Cd|2 zf5z;0Ysnw;Je$OLzjw@z#`iP8oPZ&jP?X4%pMsWV=P< zp*87Wy^L|+oY7eZwevH-2K{gj2BV8|wsH9*{ZKc#(d66Iy*1^}%zl!NHcmg<50u}T zP0>wz-fT!Pv{1E=JV zV=?p(L!WW%?!t4txf;)>}qm~5ktA7?6U!cY4kRBhxgh5 zjjq?X7X3J{8y{2A)ESRBMr75GeF?;++C2T8)AZwBOY{L{V(auY1OY9LiTt}~5D(8~ z!u3J=^i0Q(P1!Z}1CZXFXVv71LzUF?1F=qOmvqx_10c+zTVQj zxLGh~axpn$LNPgUOfhwj56;gqppnsYTtlf>*Eghw4H|c&7~RR*Uyl!5WEn=A@hCI**6#2kDcuQ!dPlNN`fdCvix0(sr-@Sr7 zvEPci#_3lbMgZXWPvASmKj8t;f#bMtP(NzHoWLxY*KmjVjQ|AvjnD8M z#=*FpBJrym*;mIefABp*eqdnR^0K?!N*zk^zTk{G)Zhw{ZH7;r9Op#58E;Hp}~AuY0I!Ip8zldV9Spb(klX7 z1)#6Dn)CZQq*blYQPUwvLu+x-X57Pj znSDF^B?gHNJfDB1ovB8!dfj8+K~o^a)5V>>C>XmO-nAM758;9 zn7@Kr@cRq$l?SNT4z)CY8qGJZRgvT1y9)F?!EdyOdNv7R0w5KjUR-wbM>=p`0sWU6 z;QkN7b!8KNk8bdu8o#mpanBs;mq%7 z!+T5fN4v)|+3>=1JsRX;0^xdPj{bd1^G6&@;hg-27w);F$FDM|a2d2)TkAce(*ryC z(7J{rsWb1f5`=)bKeq%ufEm7g+*6LG%~ugg!57`#r2Mp8gsA?;nvr(24!& zdUVmk?BtI=j}5QOl=}RG{-Yr;Pg;Hr@9gBi*!g?=i~W8*dl}?8reVIcFgy7-wzlGI z_g&j)40++$6z68Y(?Lt~U)9K(@;g{(Q>%YI8TRF%M@+2)8!ZFP%^%nEw!k-I8uJZ8 zpP>dk9>u)zg6BF7-cjQ=mVYGp&cxyfBX&ac>wBYXaol{{LJ2A-p%oaMqSjihZfR;{S0j5neyFG4z;pC zoBXa^G=mQ8)5o6#9o1+(*?^uB2xET|>vdMMVJRNq!@3&ht-P?^#J&SU zZ65|@JQkomOUP;?QFn#G3=K{%;8a6C>>A5~sRslK%xna}^Z^YB7B5gF+6uwsw{&Q&@C9E1MoJp}lD9KZ!Y z6woz#!8_FVJb*6%jLK61yjuWJ4+n+;LSgQW#P)_B@O(x*yGXbG+6(r5>TtksM*!-Y z2c!BO&&9*GM*Z6w@d88u>AC<==a+HKgm#@jRY@L(Z_AuGTuHvj`R1>QzEQQ~Q{+Vy zU_JnqU;6aZ=)NtY3jUn*eyen2A(ZLirqa{i<9G}&y8bZg=q~L&qx@;_(Ki+^Y;W;d zt$y#&-m{wi^{eW-^pN%ttLg9F`bz)hlsf;cV~`eYhPnJ;T(l+l+t|$8rLK)aJH@fs zXT(8IKkDh&!AcU_7hLD1U8vVu{h^)G&b4)Dn4T7&cE^1JJHo+!zV*eNXa)#r(T+CY z`XKh<=wT(C!L-n(gw$53HD-%yo97=Z3wD1KA5-t z8p65|akhu~V~7B>hyifHFQo0;x8AjMycaHz^s;wzcXDwa*F#0eY-hc|#o2yje;<4I{yN$ng|w{Q-R&3JEbx&81kUaw`+K@MYq;Aw z+Ap+rmtE*&>*nI_;@}}`>#|V8+I``0FNOY+3$2}<9PHgarqs)gnjGVJDK&{isXyc_ zDG7N)Yz=Ey*9A_t)*e8)Hax9+zSzmx&SkOtWP1+};KKduJ9um7>NIMxwVOSSVn+`T zR}DG2TB3*75j`A;mYZy1D5oeduOc_KKDPea9&VoYa;^)tg-K*xIF%Sd*kY913DdV?_=&V-yRH7RYhIJMpaosS=rXsLBY=9Tg(O4&T~Dj z=R(FZ-yXWUx!8h?T--*v**ZFT*xPz|x=~}u(Ztp$&miG%vZ2Zfl5WJb)s~$U*ri!Z*OPn=H%tHz<#cMokfC8*1a9;4GGbdjqSbc7u1PX zQgQ)?NA|aNH+1#_nYevpR#MW_X_PJUJF>rn^#XVMZ?9_Eg$(5Ca%h;pmK;5;T5@$P zW9fz>;0h(n#%TfY(zFcfMaROfE!j~>P>bFK@qwULKUrCGM|(*_JxLq;1ulyvp>Sal zws)6=xRUOkuC6X_9+D0&Zj!Y|Bss+isvk*NS)dBi*T%57n>bn0&~9Y^rS^*Q3JS_9 zBV-j+lvQPwm26dHtyLWCW##47?CkCBmF$!pbA0Ws_J&i*2>nZ_DX8(.SetElement(Layout3); + + Layout2.RemoveObject(0); + Layout2.AddObject( + TComponentSideBar.Create(Self).Layout1 + ) +end; + +end. diff --git a/sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Cadastros.fmx b/sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Cadastros.fmx new file mode 100644 index 0000000..ff6237b --- /dev/null +++ b/sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Cadastros.fmx @@ -0,0 +1,27 @@ +object PageCadastros: TPageCadastros + Left = 0 + Top = 0 + Caption = 'Form2' + ClientHeight = 480 + ClientWidth = 640 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + DesignerMasterStyle = 0 + object Layout1: TLayout + Align = Client + Size.Width = 640.000000000000000000 + Size.Height = 480.000000000000000000 + Size.PlatformDefault = False + object Label1: TLabel + Align = Client + StyledSettings = [Family, Style, FontColor] + Size.Width = 640.000000000000000000 + Size.Height = 480.000000000000000000 + Size.PlatformDefault = False + TextSettings.Font.Size = 30.000000000000000000 + TextSettings.HorzAlign = Center + Text = 'Cadastros' + end + end +end diff --git a/sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Cadastros.pas b/sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Cadastros.pas new file mode 100644 index 0000000..7e07ec0 --- /dev/null +++ b/sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Cadastros.pas @@ -0,0 +1,36 @@ +unit Router4DelphiDemo.View.Pages.Cadastros; + +interface + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, + FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, + FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, + Router4D.Interfaces; + +type + TPageCadastros = class(TForm, iRouter4DComponent) + Layout1: TLayout; + Label1: TLabel; + private + { Private declarations } + public + { Public declarations } + function Render : TFMXObject; + end; + +var + PageCadastros: TPageCadastros; + +implementation + +{$R *.fmx} + +{ TForm2 } + +function TPageCadastros.Render: TFMXObject; +begin + Result := Layout1; +end; + +end. diff --git a/sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Index.fmx b/sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Index.fmx new file mode 100644 index 0000000..ff5d7ae --- /dev/null +++ b/sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Index.fmx @@ -0,0 +1,27 @@ +object PageIndex: TPageIndex + Left = 0 + Top = 0 + Caption = 'Form5' + ClientHeight = 609 + ClientWidth = 940 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + DesignerMasterStyle = 0 + object Layout1: TLayout + Align = Contents + Size.Width = 940.000000000000000000 + Size.Height = 609.000000000000000000 + Size.PlatformDefault = False + object Label1: TLabel + Align = Client + StyledSettings = [Family, Style, FontColor] + Size.Width = 940.000000000000000000 + Size.Height = 609.000000000000000000 + Size.PlatformDefault = False + TextSettings.Font.Size = 30.000000000000000000 + TextSettings.HorzAlign = Center + Text = 'Home' + end + end +end diff --git a/sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Index.pas b/sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Index.pas new file mode 100644 index 0000000..5cf9cf0 --- /dev/null +++ b/sample/Demo/Views/Pages/Router4DelphiDemo.View.Pages.Index.pas @@ -0,0 +1,47 @@ +unit Router4DelphiDemo.View.Pages.Index; + +interface + +uses + System.SysUtils, + System.Types, + System.UITypes, + System.Classes, + System.Variants, + FMX.Types, + FMX.Controls, + FMX.Forms, + FMX.Graphics, + FMX.Dialogs, + FMX.Layouts, + Router4D.Interfaces, FMX.Controls.Presentation, FMX.StdCtrls; + +type + TPageIndex = class(TForm, iRouter4DComponent) + Layout1: TLayout; + Label1: TLabel; + private + { Private declarations } + public + { Public declarations } + function Render : TFMXObject; + end; + +var + PageIndex: TPageIndex; + +implementation + +uses + Router4D, + Router4DelphiDemo.Views.Layouts.Main; + +{$R *.fmx} + +function TPageIndex.Render: TFMXObject; +begin + Result := Layout1; + //TRouter4D.Render.GetElement(Layout1); +end; + +end. diff --git a/sample/Demo/Views/Router4DelphiDemo.View.Principal.fmx b/sample/Demo/Views/Router4DelphiDemo.View.Principal.fmx new file mode 100644 index 0000000..f3d1bd3 --- /dev/null +++ b/sample/Demo/Views/Router4DelphiDemo.View.Principal.fmx @@ -0,0 +1,18 @@ +object ViewPrincipal: TViewPrincipal + Left = 0 + Top = 0 + Caption = 'Form2' + ClientHeight = 612 + ClientWidth = 925 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + OnCreate = FormCreate + DesignerMasterStyle = 0 + object Layout1: TLayout + Align = Contents + Size.Width = 925.000000000000000000 + Size.Height = 612.000000000000000000 + Size.PlatformDefault = False + end +end diff --git a/sample/Demo/Views/Router4DelphiDemo.View.Principal.pas b/sample/Demo/Views/Router4DelphiDemo.View.Principal.pas new file mode 100644 index 0000000..38f5e1c --- /dev/null +++ b/sample/Demo/Views/Router4DelphiDemo.View.Principal.pas @@ -0,0 +1,36 @@ +unit Router4DelphiDemo.View.Principal; + +interface + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, + FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts; + +type + TViewPrincipal = class(TForm) + Layout1: TLayout; + procedure FormCreate(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + ViewPrincipal: TViewPrincipal; + +implementation + +uses + Router4D, + Router4DelphiDemo.Views.Layouts.Main, + Router4DelphiDemo.View.Router; + +{$R *.fmx} + +procedure TViewPrincipal.FormCreate(Sender: TObject); +begin + TRouter4D.Render.SetElement(Layout1, Layout1); +end; + +end. diff --git a/sample/Demo/Views/Routers/Router4DelphiDemo.View.Router.pas b/sample/Demo/Views/Routers/Router4DelphiDemo.View.Router.pas new file mode 100644 index 0000000..4976023 --- /dev/null +++ b/sample/Demo/Views/Routers/Router4DelphiDemo.View.Router.pas @@ -0,0 +1,45 @@ +unit Router4DelphiDemo.View.Router; + +interface + +type + TRouters = class + private + public + constructor Create; + destructor Destroy; override; + end; + +var + Routers : TRouters; + +implementation + +uses + Router4D, + Router4DelphiDemo.View.Pages.Index, + Router4DelphiDemo.Views.Layouts.Main, + Router4DelphiDemo.View.Pages.Cadastros; + +{ TRouters } + +constructor TRouters.Create; +begin + TRouter4D.Switch.Router('Home', TPageIndex); + TRouter4D.Switch.Router('Cadastros', TPageCadastros); + TRouter4D.Switch.Router('main', TMainLayout); +end; + +destructor TRouters.Destroy; +begin + + inherited; +end; + +initialization + Routers := TRouters.Create; + +finalization + Routers.Free; + +end. diff --git a/sample/SimpleDemo/SimpleDemo.View.Components.Button01.fmx b/sample/SimpleDemo/SimpleDemo.View.Components.Button01.fmx new file mode 100644 index 0000000..58ed0e7 --- /dev/null +++ b/sample/SimpleDemo/SimpleDemo.View.Components.Button01.fmx @@ -0,0 +1,47 @@ +object ComponentButton01: TComponentButton01 + Left = 0 + Top = 0 + Caption = 'Form1' + ClientHeight = 480 + ClientWidth = 640 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + OnCreate = FormCreate + DesignerMasterStyle = 0 + object Layout1: TLayout + Position.X = 232.000000000000000000 + Position.Y = 120.000000000000000000 + Size.Width = 121.000000000000000000 + Size.Height = 81.000000000000000000 + Size.PlatformDefault = False + object Line1: TLine + Align = Bottom + LineType = Bottom + Position.Y = 80.000000000000000000 + Size.Width = 121.000000000000000000 + Size.Height = 1.000000000000000000 + Size.PlatformDefault = False + Stroke.Thickness = 5.000000000000000000 + end + object Label1: TLabel + Align = Contents + StyledSettings = [Family, Style, FontColor] + Size.Width = 121.000000000000000000 + Size.Height = 81.000000000000000000 + Size.PlatformDefault = False + TextSettings.Font.Size = 20.000000000000000000 + TextSettings.HorzAlign = Center + Text = 'Button' + end + object SpeedButton1: TSpeedButton + Align = Contents + Opacity = 0.000000000000000000 + Size.Width = 121.000000000000000000 + Size.Height = 81.000000000000000000 + Size.PlatformDefault = False + Text = 'SpeedButton1' + OnClick = SpeedButton1Click + end + end +end diff --git a/sample/SimpleDemo/SimpleDemo.View.Components.Button01.pas b/sample/SimpleDemo/SimpleDemo.View.Components.Button01.pas new file mode 100644 index 0000000..80e5b8d --- /dev/null +++ b/sample/SimpleDemo/SimpleDemo.View.Components.Button01.pas @@ -0,0 +1,85 @@ +unit SimpleDemo.View.Components.Button01; + +interface + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, + FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, + FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.Layouts, + Router4D.Interfaces, + Router4D.Props; + +type + TComponentButton01 = class(TForm, iRouter4DComponent) + Layout1: TLayout; + Line1: TLine; + Label1: TLabel; + SpeedButton1: TSpeedButton; + procedure FormCreate(Sender: TObject); + procedure SpeedButton1Click(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + function Render : TFMXObject; + procedure UnRender; + [Subscribe] + procedure Props ( aValue : TProps); + function createButton(aLabel : String) : TFMXObject; + end; + +var + ComponentButton01: TComponentButton01; + +implementation + +{$R *.fmx} + +{ TComponentButton01 } + +function TComponentButton01.createButton(aLabel: String): TFMXObject; +begin + Result := Layout1; + Label1.Text := aLabel; + Layout1.Align := TAlignLayout.Left; + Line1.Visible := False; + Self.TagString := aLabel; +end; + +procedure TComponentButton01.FormCreate(Sender: TObject); +begin + GlobalEventBus.RegisterSubscriber(Self); +end; + +procedure TComponentButton01.Props(aValue: TProps); +begin + Line1.Visible := False; + + if (aValue.PropString = Label1.Text) and + (aValue.Key = 'Button01') then + Line1.Visible := True; + + aValue.Free; +end; + +function TComponentButton01.Render: TFMXObject; +begin + Result := Layout1; +end; + +procedure TComponentButton01.SpeedButton1Click(Sender: TObject); +begin + Line1.Visible := True; + GlobalEventBus.Post( + TProps.Create + .PropString(Label1.Text) + .Key('Button01') + ); +end; + +procedure TComponentButton01.UnRender; +begin + // +end; + +end. diff --git a/sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.Sub.fmx b/sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.Sub.fmx new file mode 100644 index 0000000..552a0f9 --- /dev/null +++ b/sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.Sub.fmx @@ -0,0 +1,27 @@ +object SubCadastros: TSubCadastros + Left = 0 + Top = 0 + Caption = 'Form1' + ClientHeight = 480 + ClientWidth = 640 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + DesignerMasterStyle = 0 + object Layout1: TLayout + Align = Client + Size.Width = 640.000000000000000000 + Size.Height = 480.000000000000000000 + Size.PlatformDefault = False + object Label1: TLabel + Align = Contents + StyledSettings = [Family, Style, FontColor] + Size.Width = 640.000000000000000000 + Size.Height = 480.000000000000000000 + Size.PlatformDefault = False + TextSettings.Font.Size = 30.000000000000000000 + TextSettings.HorzAlign = Center + Text = 'Sub-Cadastros' + end + end +end diff --git a/sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.Sub.pas b/sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.Sub.pas new file mode 100644 index 0000000..f2d7202 --- /dev/null +++ b/sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.Sub.pas @@ -0,0 +1,45 @@ +unit SimpleDemo.View.Page.Cadastros.Sub; + +interface + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, + FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, + FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, + Router4D.Interfaces; + +type + TSubCadastros = class(TForm, iRouter4DComponent) + Layout1: TLayout; + Label1: TLabel; + private + { Private declarations } + public + { Public declarations } + function Render : TFMXObject; + procedure UnRender; + end; + +var + SubCadastros: TSubCadastros; + +implementation + +uses + Router4D.History; + +{$R *.fmx} + +{ TSubCadastros } + +function TSubCadastros.Render: TFMXObject; +begin + Result := Layout1; +end; + +procedure TSubCadastros.UnRender; +begin + // +end; + +end. diff --git a/sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.fmx b/sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.fmx new file mode 100644 index 0000000..3f760bc --- /dev/null +++ b/sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.fmx @@ -0,0 +1,74 @@ +object PageCadastros: TPageCadastros + Left = 0 + Top = 0 + Caption = 'Form3' + ClientHeight = 480 + ClientWidth = 640 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + OnCreate = FormCreate + DesignerMasterStyle = 0 + object Layout1: TLayout + Align = Client + Size.Width = 640.000000000000000000 + Size.Height = 480.000000000000000000 + Size.PlatformDefault = False + object Layout2: TLayout + Align = Left + Size.Width = 177.000000000000000000 + Size.Height = 480.000000000000000000 + Size.PlatformDefault = False + Visible = False + object Rectangle1: TRectangle + Align = Contents + Fill.Color = xFF36414A + Size.Width = 177.000000000000000000 + Size.Height = 480.000000000000000000 + Size.PlatformDefault = False + Stroke.Kind = None + end + end + object Layout3: TLayout + Align = Client + Size.Width = 640.000000000000000000 + Size.Height = 399.000000000000000000 + Size.PlatformDefault = False + object Label1: TLabel + Align = Contents + StyledSettings = [Family, Style, FontColor] + Size.Width = 640.000000000000000000 + Size.Height = 399.000000000000000000 + Size.PlatformDefault = False + TextSettings.Font.Size = 30.000000000000000000 + TextSettings.HorzAlign = Center + Text = 'Cadastros' + end + object Button1: TButton + Anchors = [] + Position.X = 243.682922363281300000 + Position.Y = 215.990631103515600000 + Size.Width = 145.000000000000000000 + Size.Height = 41.000000000000000000 + Size.PlatformDefault = False + Text = 'Voltar para Home' + OnClick = Button1Click + end + object Edit1: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + Anchors = [] + Position.X = 243.682922363281300000 + Position.Y = 257.240631103515600000 + Size.Width = 145.000000000000000000 + Size.Height = 25.000000000000000000 + Size.PlatformDefault = False + end + end + object Layout4: TLayout + Align = Top + Size.Width = 640.000000000000000000 + Size.Height = 81.000000000000000000 + Size.PlatformDefault = False + end + end +end diff --git a/sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.pas b/sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.pas new file mode 100644 index 0000000..18867d8 --- /dev/null +++ b/sample/SimpleDemo/SimpleDemo.View.Page.Cadastros.pas @@ -0,0 +1,114 @@ +unit SimpleDemo.View.Page.Cadastros; + +interface + +uses + System.SysUtils, + System.Types, + System.UITypes, + System.Classes, + System.Variants, + FMX.Types, + FMX.Controls, + FMX.Forms, + FMX.Graphics, + FMX.Dialogs, + FMX.Controls.Presentation, + FMX.StdCtrls, + FMX.Layouts, + Router4D.Interfaces, + Router4D.Props, FMX.Edit, FMX.Objects; + +type + TPageCadastros = class(TForm, iRouter4DComponent) + Layout1: TLayout; + Label1: TLabel; + Button1: TButton; + Edit1: TEdit; + Layout2: TLayout; + Layout3: TLayout; + Rectangle1: TRectangle; + Layout4: TLayout; + procedure Button1Click(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + procedure CreateMenuSuperior; + procedure CreateRouters; + { Private declarations } + public + { Public declarations } + function Render : TFMXObject; + procedure UnRender; + [Subscribe] + procedure Props ( aValue : TProps); + end; + +var + PageCadastros: TPageCadastros; + +implementation + +uses + Router4D, SimpleDemo.View.Page.Cadastros.Sub, SimpleDemo.View.Page.Principal, + SimpleDemo.View.Components.Button01; + +{$R *.fmx} + +{ TPageCadastros } + +procedure TPageCadastros.Button1Click(Sender: TObject); +begin + TRouter4D.Link.&To('Inicio'); +end; + +procedure TPageCadastros.FormCreate(Sender: TObject); +begin + CreateRouters; + CreateMenuSuperior; +end; + +procedure TPageCadastros.Props(aValue: TProps); +begin + if (aValue.PropString <> '') and (aValue.Key = 'TelaCadastro') then + Label1.Text := aValue.PropString; + + aValue.Free; +end; + +procedure TPageCadastros.CreateRouters; +begin + TRouter4D.Switch.Router('Clientes', TPagePrincipal, 'cadastros'); + TRouter4D.Switch.Router('Fornecedores', TSubCadastros, 'cadastros'); + TRouter4D.Switch.Router('Produtos', TSubCadastros, 'cadastros'); +end; + +procedure TPageCadastros.CreateMenuSuperior; +begin + Layout4.AddObject( + TComponentButton01.Create(Self) + .createButton('Clientes') + ); + + Layout4.AddObject( + TComponentButton01.Create(Self) + .createButton('Produtos') + ); + + Layout4.AddObject( + TComponentButton01.Create(Self) + .createButton('Fornecedores') + ); +end; + +function TPageCadastros.Render: TFMXObject; +begin + Label1.Text := 'Cadastros'; + Result := Layout1; +end; + +procedure TPageCadastros.UnRender; +begin + // +end; + +end. diff --git a/sample/SimpleDemo/SimpleDemo.View.Page.Principal.fmx b/sample/SimpleDemo/SimpleDemo.View.Page.Principal.fmx new file mode 100644 index 0000000..7ec3b02 --- /dev/null +++ b/sample/SimpleDemo/SimpleDemo.View.Page.Principal.fmx @@ -0,0 +1,47 @@ +object PagePrincipal: TPagePrincipal + Left = 0 + Top = 0 + Caption = 'Form3' + ClientHeight = 480 + ClientWidth = 640 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + DesignerMasterStyle = 0 + object Layout1: TLayout + Align = Client + Size.Width = 640.000000000000000000 + Size.Height = 480.000000000000000000 + Size.PlatformDefault = False + object Label1: TLabel + Align = Client + StyledSettings = [Family, Style, FontColor] + Size.Width = 640.000000000000000000 + Size.Height = 480.000000000000000000 + Size.PlatformDefault = False + TextSettings.Font.Size = 30.000000000000000000 + TextSettings.HorzAlign = Center + Text = 'Home' + end + object Button1: TButton + Anchors = [] + Position.X = 240.000000000000000000 + Position.Y = 264.000000000000000000 + Size.Width = 169.000000000000000000 + Size.Height = 33.000000000000000000 + Size.PlatformDefault = False + Text = 'Cadastros Simples' + OnClick = Button1Click + end + object Button2: TButton + Anchors = [] + Position.X = 240.000000000000000000 + Position.Y = 304.000000000000000000 + Size.Width = 169.000000000000000000 + Size.Height = 33.000000000000000000 + Size.PlatformDefault = False + Text = 'Cadastros com Props' + OnClick = Button2Click + end + end +end diff --git a/sample/SimpleDemo/SimpleDemo.View.Page.Principal.pas b/sample/SimpleDemo/SimpleDemo.View.Page.Principal.pas new file mode 100644 index 0000000..8bc83a5 --- /dev/null +++ b/sample/SimpleDemo/SimpleDemo.View.Page.Principal.pas @@ -0,0 +1,69 @@ +unit SimpleDemo.View.Page.Principal; + +interface + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, + FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, + FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, + Router4D.Interfaces; + +type + TPagePrincipal = class(TForm, iRouter4DComponent) + Layout1: TLayout; + Label1: TLabel; + Button1: TButton; + Button2: TButton; + procedure Button1Click(Sender: TObject); + procedure Button2Click(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + function Render : TFMXObject; + procedure UnRender; + end; + +var + PagePrincipal: TPagePrincipal; + +implementation + +uses + Router4D, + Router4D.Props; + +{$R *.fmx} + +{ TPagePrincipal } + +procedure TPagePrincipal.Button1Click(Sender: TObject); +begin + TRouter4D.Link.&To('Cadastros'); +end; + +procedure TPagePrincipal.Button2Click(Sender: TObject); +begin + TRouter4D.Link + .&To( + 'Cadastros', + TProps + .Create + .PropString( + 'Olá Router4D, Seu Cadastro Recebeu as Props' + ) + .Key('TelaCadastro') + ); +end; + +function TPagePrincipal.Render: TFMXObject; +begin + Result := Layout1; +end; + +procedure TPagePrincipal.UnRender; +begin + // +end; + +end. diff --git a/sample/SimpleDemo/SimpleDemo.View.Principal.fmx b/sample/SimpleDemo/SimpleDemo.View.Principal.fmx new file mode 100644 index 0000000..fe7ea79 --- /dev/null +++ b/sample/SimpleDemo/SimpleDemo.View.Principal.fmx @@ -0,0 +1,71 @@ +object Form2: TForm2 + Left = 0 + Top = 0 + Caption = 'Form2' + ClientHeight = 586 + ClientWidth = 875 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + OnShow = FormShow + DesignerMasterStyle = 0 + object Layout1: TLayout + Align = Client + Size.Width = 875.000000000000000000 + Size.Height = 586.000000000000000000 + Size.PlatformDefault = False + object Layout2: TLayout + Align = Top + Size.Width = 875.000000000000000000 + Size.Height = 50.000000000000000000 + Size.PlatformDefault = False + object Rectangle1: TRectangle + Align = Contents + Fill.Color = xFF36414A + Size.Width = 875.000000000000000000 + Size.Height = 50.000000000000000000 + Size.PlatformDefault = False + Stroke.Kind = None + end + object Label1: TLabel + Align = Contents + StyledSettings = [Family, Style] + Margins.Right = 10.000000000000000000 + Size.Width = 865.000000000000000000 + Size.Height = 50.000000000000000000 + Size.PlatformDefault = False + TextSettings.Font.Size = 15.000000000000000000 + TextSettings.FontColor = claWhite + TextSettings.HorzAlign = Trailing + Text = 'Router4D - SimpleDemo' + end + end + object Layout4: TLayout + Align = Client + Size.Width = 705.000000000000000000 + Size.Height = 536.000000000000000000 + Size.PlatformDefault = False + end + object Layout3: TLayout + Align = Left + Position.Y = 50.000000000000000000 + Size.Width = 170.000000000000000000 + Size.Height = 536.000000000000000000 + Size.PlatformDefault = False + object Rectangle2: TRectangle + Align = Contents + Fill.Color = xFF2D2F32 + Size.Width = 170.000000000000000000 + Size.Height = 536.000000000000000000 + Size.PlatformDefault = False + Stroke.Kind = None + end + object Layout5: TLayout + Align = Client + Size.Width = 170.000000000000000000 + Size.Height = 536.000000000000000000 + Size.PlatformDefault = False + end + end + end +end diff --git a/sample/SimpleDemo/SimpleDemo.View.Principal.pas b/sample/SimpleDemo/SimpleDemo.View.Principal.pas new file mode 100644 index 0000000..24ddde2 --- /dev/null +++ b/sample/SimpleDemo/SimpleDemo.View.Principal.pas @@ -0,0 +1,79 @@ +unit SimpleDemo.View.Principal; + +interface + +uses + System.SysUtils, + System.Types, + System.UITypes, + System.Classes, + System.Variants, + FMX.Types, + FMX.Controls, + FMX.Forms, + FMX.Graphics, + FMX.Dialogs, + FMX.Controls.Presentation, + FMX.StdCtrls, + FMX.ListBox, + FMX.Layouts, + FMX.Objects, FMX.Edit, FMX.SearchBox, FMX.MultiView; + +type + TForm2 = class(TForm) + Layout1: TLayout; + Layout2: TLayout; + Layout3: TLayout; + Layout4: TLayout; + Rectangle1: TRectangle; + Rectangle2: TRectangle; + Label1: TLabel; + Layout5: TLayout; + procedure FormShow(Sender: TObject); + private + procedure RegisterRouters; + procedure createSideBar; + { Private declarations } + public + { Public declarations } + end; + +var + Form2: TForm2; + +implementation + +uses + Router4D, + SimpleDemo.View.Page.Cadastros, + SimpleDemo.View.Page.Principal; + +{$R *.fmx} + +procedure TForm2.FormShow(Sender: TObject); +begin + RegisterRouters; + TRouter4D.Render.SetElement(Layout4, Layout1); +end; + +procedure TForm2.RegisterRouters; +begin + TRouter4D.Switch.Router('Inicio', TPagePrincipal); + TRouter4D.Switch.Router('Cadastros', TPageCadastros); + TRouter4D.Switch.Router('Configuracoes', TPageCadastros); + createSideBar; +end; + +procedure TForm2.createSideBar; +begin + TRouter4D + .SideBar + .MainContainer(Layout5) + .LinkContainer(Layout4) + .FontSize(15) + .FontColor(4294967295) + .ItemHeigth(60) + .RenderToListBox; +end; + +end. diff --git a/sample/SimpleDemo/SimpleDemo.dpr b/sample/SimpleDemo/SimpleDemo.dpr new file mode 100644 index 0000000..d6de8f7 --- /dev/null +++ b/sample/SimpleDemo/SimpleDemo.dpr @@ -0,0 +1,19 @@ +program SimpleDemo; + +uses + System.StartUpCopy, + FMX.Forms, + SimpleDemo.View.Principal in 'SimpleDemo.View.Principal.pas' {Form2}, + SimpleDemo.View.Page.Principal in 'SimpleDemo.View.Page.Principal.pas' {PagePrincipal}, + SimpleDemo.View.Page.Cadastros in 'SimpleDemo.View.Page.Cadastros.pas' {PageCadastros}, + SimpleDemo.View.Page.Cadastros.Sub in 'SimpleDemo.View.Page.Cadastros.Sub.pas' {SubCadastros}, + SimpleDemo.View.Components.Button01 in 'SimpleDemo.View.Components.Button01.pas' {ComponentButton01}; + +{$R *.res} + +begin + ReportMemoryLeaksOnShutdown := True; + Application.Initialize; + Application.CreateForm(TForm2, Form2); + Application.Run; +end. diff --git a/sample/SimpleDemo/SimpleDemo.dproj b/sample/SimpleDemo/SimpleDemo.dproj new file mode 100644 index 0000000..77222db --- /dev/null +++ b/sample/SimpleDemo/SimpleDemo.dproj @@ -0,0 +1,904 @@ + + + {3AD0DA23-7F3C-401B-92FF-B74A312EBB37} + 19.0 + FMX + True + Debug + Win32 + 32787 + Application + SimpleDemo.dpr + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + true + true + true + true + true + true + true + true + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\delphi_PROJECTICNS.icns + SimpleDemo + + + DBXSqliteDriver;RESTComponents;DBXInterBaseDriver;emsclientfiredac;tethering;DataSnapFireDAC;bindcompfmx;fmx;FireDACIBDriver;FireDACDBXDriver;dbexpress;IndyCore;dsnap;emsclient;DataSnapCommon;FireDACCommon;RESTBackendComponents;soapserver;bindengine;CloudService;FireDACCommonDriver;DataSnapClient;inet;IndyIPCommon;bindcompdbx;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;FireDACSqliteDriver;soaprtl;DbxCommonDriver;xmlrtl;soapmidas;DataSnapNativeClient;FireDACDSDriver;rtl;DbxClientDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + DBXSqliteDriver;RESTComponents;DBXInterBaseDriver;emsclientfiredac;tethering;DataSnapFireDAC;bindcompfmx;fmx;FireDACIBDriver;FireDACDBXDriver;dbexpress;IndyCore;dsnap;emsclient;DataSnapCommon;FireDACCommon;RESTBackendComponents;soapserver;bindengine;CloudService;FireDACCommonDriver;DataSnapClient;inet;IndyIPCommon;bindcompdbx;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;FireDACSqliteDriver;soaprtl;DbxCommonDriver;xmlrtl;soapmidas;DataSnapNativeClient;FireDACDSDriver;rtl;DbxClientDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + DBXSqliteDriver;RESTComponents;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;bindcompvclsmp;emsclientfiredac;tethering;svnui;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;DBXOracleDriver;inetdb;emsedge;fmx;FireDACIBDriver;fmxdae;vcledge;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;emsclient;DataSnapCommon;IWBootstrapD104;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;Intraweb_15_D10_4;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;TBGWebCharts;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;soaprtl;DbxCommonDriver;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;IWBootstrap4D104;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DBXSqliteDriver;RESTComponents;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;bindcompvclsmp;emsclientfiredac;tethering;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;DBXOracleDriver;inetdb;emsedge;fmx;FireDACIBDriver;fmxdae;vcledge;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;emsclient;DataSnapCommon;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;soaprtl;DbxCommonDriver;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + true + PerMonitorV2 + true + 1033 + + + true + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + PerMonitorV2 + + + + MainSource + + +
    Form2
    + fmx +     + +
    PagePrincipal
    + fmx +     + +
    PageCadastros
    + fmx +     + +
    SubCadastros
    + fmx +     + +
    ComponentButton01
    + fmx +     + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + +     + + Delphi.Personality.12 + Application + + + + SimpleDemo.dpr + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + True + True + True + True + + + + + true + + + + + true + + + + + true + + + + + SimpleDemo.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 1 + + + classes + 1 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + 12 + + + + +     diff --git a/sample/SimpleDemo/SimpleDemo.dproj.local b/sample/SimpleDemo/SimpleDemo.dproj.local new file mode 100644 index 0000000..f9c33ff --- /dev/null +++ b/sample/SimpleDemo/SimpleDemo.dproj.local @@ -0,0 +1,21 @@ + + + + 2020/07/13 23:31:02.000.010,=C:\Users\thuli\Documents\Embarcadero\Studio\Projects\Unit2.pas + 2020/07/13 23:31:25.000.893,D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\SimpleDemo.View.Principal.pas=C:\Users\thuli\Documents\Embarcadero\Studio\Projects\Unit2.pas + 2020/07/13 23:31:25.000.893,D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\SimpleDemo.View.Principal.fmx=C:\Users\thuli\Documents\Embarcadero\Studio\Projects\Unit2.fmx + 2020/07/13 23:31:29.000.939,D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\SimpleDemo.dproj=C:\Users\thuli\Documents\Embarcadero\Studio\Projects\Project2.dproj + 2020/07/13 23:34:29.000.476,=D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\Unit3.pas + 2020/07/13 23:35:18.000.719,D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\SimpleDemo.View.Page.Principal.fmx=D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\Unit3.fmx + 2020/07/13 23:35:18.000.719,D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\SimpleDemo.View.Page.Principal.pas=D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\Unit3.pas + 2020/07/13 23:35:59.000.833,=D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\Unit3.pas + 2020/07/13 23:36:34.000.131,D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\SimpleDemo.View.Page.Cadastros.pas=D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\Unit3.pas + 2020/07/13 23:36:34.000.131,D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\SimpleDemo.View.Page.Cadastros.fmx=D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\Unit3.fmx + 2020/07/15 11:34:37.000.719,=D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\Unit1.pas + 2020/07/15 11:35:34.000.042,D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\Unit1.fmx=D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\SimpleDemo.View.Page.Cadastros.Sub.fmx + 2020/07/15 11:35:34.000.042,D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\Unit1.pas=D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\SimpleDemo.View.Page.Cadastros.Sub.pas + 2020/07/16 23:06:18.753,=D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\Unit1.pas + 2020/07/16 23:07:42.491,D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\SimpleDemo.View.Components.Button01.pas=D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\Unit1.pas + 2020/07/16 23:07:42.491,D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\SimpleDemo.View.Components.Button01.fmx=D:\Projetos\Frameworks\Router4Delphi\sample\SimpleDemo\Unit1.fmx + + diff --git a/sample/SimpleDemo/SimpleDemo.identcache b/sample/SimpleDemo/SimpleDemo.identcache new file mode 100644 index 0000000000000000000000000000000000000000..bd3b7e3ed8b1ad61ec1f28c359d22430c457de68 GIT binary patch literal 493 zcmZQ&U|@)Jv5E;O%FjwI$uEv^D@x2wEzd8?E{+MxFD*$eGI2@GDago-DNf8S$VrU} z&IC~|sk!+`Ouewo)N;Lm#Pn1>=fsr6;*z5LV!eXIVxZx05K9|df=iRoZE~gDrj&vr fxWj=As)kTNQD$CpWOy1PRtcQ+&+a9IEVQs1Rh literal 0 HcmV?d00001 diff --git a/sample/SimpleDemo/SimpleDemo.res b/sample/SimpleDemo/SimpleDemo.res new file mode 100644 index 0000000000000000000000000000000000000000..c0b549e7323fc252088a965a7d52f76e40579455 GIT binary patch literal 112124 zcmeGl2Rv0@_}WpaXlRIrl#(qgRLY2wXqPP-$ciFVTC{|UN|8eUcG33I`uA^AS`U=_+>~;Bql)E5dM#Y-*}zp{aiy3nEopc+FghGmLL!z?M>|? zVgWqh0(>5X8{tGa6LSHZ6S07>2h7fd1K|P@4XAPC31vc_PzO*38jvDwqCKRg#n*#0 z?u0EBk1ODFg0#-mY$n6+g@h{=E5=$##YzCCc68~dz#BKf@GYGJF&yI1fB?RGLwr++ z}b5^KVaiqi$2GonG2%EMQjc7!LS@&Jh?4j)n$$W?wbVMYQ9GC$rq*9SB0|grVLjbMGe~pDy;6vVUCm z<@3!U>en5-dRPycIk>&ru<R zk2k?=tcK?O_Orb9%4W7-aNTap4%Na++X)Xkr%!OZeL8nXR`h$Js2u~9N{zQwY8Bor z%<42aF3fCRk-}ac)9|h2`=^E!?im47tbFqd6?Bz0af<{@uL$qonS1)~<3(x0|8PCv z5)X*hC<^Awvz;6sC%9Yqq{$A|?%Rk3!p6Kw#2}ui2<@xk+B4P;FDsH?94_luMwzj@ z<22!6eBF84FR41~_967)Lxbqv7JW?!g*TZKMCJLm@f!;y@hq?snZ*6C!L@0jJkJIg z@w*Ux^JU~aO|$a(q>)EhWGi!BUgM%E8YmvHJ#M3up5SgnjU;OsVtl~Ez}!G}y|vaC zUZ39M;c6rrFgV*wm8XxDrPaik#pPep7gyFL`UQv+9Vvm8L%uj%Y8bBVojMFa4^m`aq`eW{lLsX{b6@zONpDtrtzANy72J> zuWvUsUcdc^Ph6o?Q*Kd2BXZxw@yz3mB*y)lyz>iXYk&(^WtWb}CS?>0P3pgGq0cAH z^o#eEOo&UbGH)yAIOe#<1ga&LJPAnQ@;|0ks*q>(Zu6i3#qy*=!5pz1tC&e%GJX3B z9O89O)=HkNv2Dp7L92GYnF?zo%cY6vhz| z&Z<+MxB2upqEgEb$lmd@)Yx_^o%e31Y%gJ+3DUhn54?NGog|UNMgyC zg}LsO>3Sn85*MB0o27TZ|G!28qCFxBBj3!&-PBgcyH8X(G&LZ4`mUvCJtP;&zZ2DU z8hyJ{pl#2Zb3PXSp9F57)Or{$td|~dLd5N=whff%((RsU?8FW6{yC{>8o5^HgNSUe z5@MO4?`Vzg-P#uhO3d7~G}c4%q-vr_fQx2#S5;S`Cs|V^yn48vd3~CU5Z*gwoC$aS z!nyuAizyS*kH$}%$yar`AZz?yo`j%P6N$L;vRtnH8&CA=r=0t zQ?VSs*Om=qGvc~YdPd~Vkrp>Nsk{JC<=W+N$1Eu`T7Nk@U~=z81FbJf0Zpo0HM+{H zEE9};x~W|)$eJ6+lQ7WzRn!`gRf$w&_rxA4i6_JZSNmnEPtn+9G;dpXpjMhl>8BlR zAAi+T%GGGVFmJO`K}zyY2dnP+IzZ{9*G@U{OZ<&YAL7$nfjT@ATQ`hdZxp;XlrkVa zu*1}+C0u1mF9}jtZkg0v5!a0_nxw4wzpfefNTgMah21`*Ycb=_cgUB{_PV`A*iP-; zr|y8sc8!CpRGjUk#H}|1$dg*hlH&iGW>~a`HxfKsV|%2m+y9x%|I5Pt&iv6CCivKr zYp%hyJ@-3nwe!s=$T|sG4=MqY#8)_Kk)?>J!$j`YGj^Rd)7TVvS%WJqv1AsPuf9h2 zxK$VVF4*~eQq0q>5Y6N@JyUjg(2Ql{6P6TnyIRfKqB~4fH{r2=xBQQZA0*qg)6|d* z(@x)}WJD@-=x~p?#Cwmp7or{VcIiCRJ3P@FUw+gbMlQMVaTa$U%kcF*g2i55+pO_I z-auMKu*iJaXtB}S6Sv(OqdNXkn&8fzE8jopQt>e-S@h6*$pw}IvuAI*(WU#kw9iq4 z#wl{G<=wV+@bq}+iCs?eJ}?kSpZuX_^o5UAk&a_`z5DmI{C?-LH!dwUkeKK9-|Kdn zn!C^MbS>_+yxUO0tp_Eiom%6XX14sw_;y{mc^U0Rh@I`tq%3jxgOsd5J!L7pwcvsF|?&D&*<9(NN zBcol*g;G7m39-Dc1Gl6dy!_U!M}D^(?(XSn7gXQ&wqMkCU`)p>cf-3v&E4%N`J9LWGz{#7O=AF2dw+hzOPkMeT8FBpWZx!Z)kvD+>`;KAC{kAIm5Cl@srpV)d8MG51ne>M>}1} zGcvPO7gOw+swz?7sr24UvbX3h$$xIiy2|x`dg#K(9qsNf?AA?+qHOpfZ_}fD{kEk9 zRLL$jJ@vBha=u`B#hwNaJ@-HF5Ho{2JHB|s{AKM;Wu8{cn+3bSlhwV{E_>$Kng^QK zv%QC2%q)x*zErVniR-%8r&A8U7M>qTK=swtoBz?Vh{|fhgy<+e>wHAjt>n#Qp=C_> zQRCYWe1B}Cq`(IkpHHGEpI9HPB!=r3yqMbY`Xj48c`sAO+;}=-i+0}9yXk#y&20DH zIYz(NsRzkB1tID!)bM^T%fyVD`)_THAFbJ^G%@D2%ZPD1gMzp{ybM=c97@m=f2A^M z3$N*nxYFe_#KU?$y?HQ6var(fuJ6aVZJHA|&fvKc<1y`Z**X`^jO`sW$7hHF&Vzau zes&tw_v6DKEuJ{T`FzAaiCx@z%3*{0XRNg>Pf|MnL^EM*d#K5Rx`ij6-!~{-x~h|G za@E?)bChDg@D!)@a^xFcx^RD@%MJ?@;=;#1#17M2euGuIz7f9Xc;UHF z>~v{e>AuL53h_2r$qt*Ol09j}^O;x7Weh7`y>z_rM&#x#Y5jwNWtE#ezsxwN zc8BkSjI(8ewc&^30=JT9k1tS)9yIIyn9c^Pl{a2%?vx&3`-3lUwXb)U&8h5rmz z5xII*)bYZ+?k3Xya%aTXl%8Ae7igP!^!YmJ0JD9OeD{mD8LJ3w822IV; zn%oEPLIzt5S$p0g-S^V#ZIhFEQ%3TiJXTTUneC-L{d&hKXZT$Erd2t_z1!gAGXBk~ z8?k9C7Jf{BUUY?6_A+zA73af4BhX5^&Av1-L*2bVFY@r|uva%{$42N@`GyERNRPJz zX|EK5OboAH?Y;T*JDZ!^&yHTY;6eV|ygtx=#9v+|6ABp0`{Ykgn;c`#*R!{?Zeh3M z@{4x~zkhJ$pslN7{tBZ7j+e2h@}`|nG3$6`+mU{^wvv6_qZ00RIlG@nx-3b_X>acY zz4kfsR{M$`nP!ESjw3?&J6yTuofERz*$(vsaEFs-U>mARr+&KoH*3DPAx;|VuE~?W9 zXbP&HR}~oa&GZXga<kO72=ri$&NdHNXWiHj!st{oi09dh@%CHEW!<@E?tcqXFaK*Ne|6)fZOWT3>nC5$ zTC`L|bHcSOFPRgU<1H*Y<|%K_t_s^QCdKg75)<=z#?R8AZFo?S_4;+q3)h*1gh0s_ z?RTqe#L~_lcI195ed3uMZ@=e>87qfQG4rtG9UT(U{pNL1g~g9Izgo6*^P@`_ADvLp z59&SBcu(GboxSf*O^yvRcty_X&6VvSwk2p)reK+0-he5~jR(Bza>q`7#x<)GNz1J} z-?TJXR=KHh4xuSJi0zDuCpOZ7-+y->@t4haJ~ZIltdX8Y#uV!zCulRwFY z??lrRRx_<|w74lY?*8Jt8vIvJbUx%Xz`ry*Pou_ML%6Ef>Fim?`6a%2gNMray)hh^ zl-d1^&CwEydCn#`e7I zZ)H-&Mnvp$zZ24n2=tySNh$Ts9P&PL_DuFt0IY_r#=jmgxOMoMWpZ0NF&)yp+~2S6n5`9L6i_lVOk<8 zMm_njo;vz!ZuY2$({smLnvRKh1Dv-)?r)n(IcFD=0j zI(IvDh#-W;Qtu45=zX1+ckG!7q~P;o-O|%K^!=1ua&3pA;TfJncOF0YBf(4k!`5vv zUgdgm^s(GoM=mU%KC35m1*>lEZ>Kp{lV@&4lG2_Omy#&LNK{CBP|wq55+bXtroZ~^ zw+Y&7pfCQ_sOW3|+6~m?8A0r*xu9;^-fB?Vy8%X5Hl*$7SDG0t*h4N{*j{(-&c&20 z>t1&5q1L`4YZ!1%vGcrym&Y7k^Od; zjXGWxyJz(L_R_((eMV`7aY=P5<6UK6z5m3Lk0zg8`lV@$>gLt>3nVy(_Y%1m;2W6r z&y6^NtPXwNB+aySCMRv0&v$}bsUqZHwB@5N=gFzXyW_UM*mB3T?3!r$=At{whM$s0 z>{)RAi1vKGlC6Z-mJsuVeo7tM_49un{nBiE^2F=aC1J~Y$sa%5a~D*tMgTx3z&(d?<* zM*{gRUs$O0xwkT7{@^UX6pw+`MjwvxoJca#7S4(*ZSN;VEUYt*LEmRa&x=8S}3R_oY-eLcK`h~d++fUKHFXP-+Z80_TI|VPm@9?uS|B1Qv1jg zS6z9Q&or?{jNdvbIQ0@4wqdX3o1%}BgN;5e6FG8S;6+~f*v!jLvXrg~Z^L>G84$if zXjRwC!;f)EB_%6_+Pr^1jq+-jT#+-EF|q30p>1YIw@m1Au3Yuv%+Ch;>C(10Ze5%g z6f;dfCt_sE+nvN9E?Kk9LsV?`8NN-P?D6vSxoxMfU)>gE91t^0hXQ#OoA}ineivR}nWA;#ra&yclIqbGgnZXdkMvSH?bg#*x{f}ry^gDr zIKg9@kzyBW^~G#?P;lIUye$eo>Hm&U^o{b|=~+_|zGA6#z^#D;CMWhc7JZT__{@8} zM(Bl0QHp|>x(-dM?h;c$Od59n!s!Hab0Z70X@f#N1KcQ~KF1J|laNfjTLDss%C!R_&K?Zv(!O(2l)99jeIVZ~x_c9XWKWajp zNb0=G#*gsZz;l;(cdzlCMUqaA*H7CYuXpOvr%Gd@=XKE-^D9C9to2uWboHA*FZ3MW zG|Nr9=W^ez^v{@G7f18rx7_*LJK25Krbg+GuDW+XGCVFtjCL1*o z`3Xw~5hEuje);#py^@Kl3I|=f7aJ2cD(k`$BTr1@x*d4^S!B_6;>GlF775Q4JA_1R zi#T=j^{7LO(le?J@9^Fo;-ejwsCMtN<3jOruSCh44qa{%@1xg8`kjwAA0XdB)ON+T z+peGAhJA>hrZd(|G+>^wb-TQQS5JB0cI{N{)!{Vnk!8LfcX*F<|JcraegAg5;@M{um}9JdZh)DmY`d8MG<%0^-SFyC0pHuV#FzzQw=4P!o_FDT zq3%99!L3`cSd{S^A(zX>kJ3iHO&*^_R2UN{;tIqspZs*3#yahw0}piPZZ&s%$6NJDZpr@L;jb5tPw-YW zGZeX}Eh9cIdU@%yjUoZY?X5aiYw;1&WW48uC5G5^xw`S%Bd_ox9%&Is^ksDQOJ9kF7F(5EmDNW zh6sup_%4{6XHe1g(3~-+Jk$qX5upe~7=PMHMBKC8w%g28I!fy3jSXU=s=dmS5@8^( zwxomDz3!BGMTP;1w$`0DspW{KTNe%WekuD_BuelR*RT)esRAODM^cAZQ+m7Y*H7p& zxVyrLUAhILl~7$A&N=B5nnCH#b7RScyHlsW(mI+S)+_MH@!-qP&e|?GbJSySHLsY+ z&7G?^cO5ENa~rVCT?!Go%eI<(7_DEqS>8~*Vl42}?T~MD&d2glPa(_C)uSy1t%lE# zFwKZMGz=;>=y;!ndQ|Aml9itihJGM?Ph&kAu=uTK^ltO4pmME*OPzu|e5an0J0sWm zO<`!ia}O$mI!O^X+%vf*Dng|mdc$_Y)8()F2^i_8r^xSB%N-jMHm%TK>iktgmmJD7 zQm$K^*=wP*XAH!B)UHmO|El+aP^&bXb%oD1og<^?`+R!$Ob%L^HwI%9%%{7l-(0va zRO7{s^vxaO%d*<9JTPVaGcx7w!{BPEfUSYsh95}0@4xbKpFG=*8;Z~B=zd9)-g`iF zf5Ktamv_&Co zU65pe-tv9NC-9%%aI)VJ?czQcL+vF;5dX$L>=WS3V`8*ymduPeemgOk5J_-ZrgGul zvZaHw$W5;_0*E`|&+hBk?dHu_o^)?if_L8AfeN<<`MnbavSntS33+kP9p(Y9%lFOu z+?z)#AUVzYqKxypu?B;jDqgD}on3NZe=5&Lk$=1=9xF}Z@!m)6NDRBvG2q(Xm??>J z&(8?MxOemAPiGBRE1t61T(z^*=HHQ(0^UJ$CI>9-^^g4HY^ecL6Zg9=>H~Df6^p)(&qnxF0 z_ShRu>d4<6Az(~IEVIgzYyRG8-_;H)2@c{QPhxf!y*NEvS_{?W(>VS>b|6Z*e zl%KAvBOmtU@?xXDfxWJD;Cb@U+F2?5X87@#E86e%YF0g7dElW@1j%1^_VsC=LuDhw z-qr+m7qU3%KrGXIlQjAIEO$Yu7~%%>ItDXQLW{G4)6)Bk|F?5RHD$LTr64Pu5}U3c zGj4m5*G=(cY4@iR3dvcsG$N0^Ivj0s#P~$f2)#??(LFz`UiCzKyR6T^d0hp^q@G+j zQ2TVJTmBb1xc@gWZ_R)0{jV4m_@5S!oqq1{i{UriHTf&|>=_iWI!$I&;u9f0M@#*R z_yLX=Dr}$!Z=`RYl$9|;?`6$oo0m0bpQ?sQ^fKc&Buk3H%Sz1QWWNq?8Go z^w>4D`h)MZ<%@f4N-0+jQFu{WL)xs_QvP3F%(+Pw@#Z`--31>eS${e)Qg*~_!*}tA z4fT~5l#^$|AOJ7|uXGo4k-hjy+?Vf7LcSx6(&@cQjUt#Wtf#PXL zy5*kJt+`#PTk|v}Sh3>6svX3zJGXd77)b1#N6emm_riwD%a-2Ls_YecTgz|><>tR# zg*Ihn+FU<=V=F3TRTXyOnURcf;o$d9BdqbGEk%e@s{E};(M&A@q8sK;TVQj%u zlP?FeEjQ#m4SMA;d(g=2l+4~?>VYn5cVve1TnO}7FWSweT+4cD_gM8YHg~q~-B6}@ z{m!Rs`5xMYwLwXh<;A6+$GjKIb0iKO)k;3T!%}Plw|6gZ?ne`0>=?4L9}Jxz_gUp+ zWxPx8-ImHtTCa3P&feOz;gC$h!|c(|1NC2~7g=_kHI+K%gp%QxdAh3!5j(T9UWQMB zPpVBo+WnOZK1!hyQKQ_*jrs?QHb_W|+ZPLy#r|8WGlqq{nWkLLquN7miM<-SaU(uBt$`WTa@$iqaV#hl)U;M&FpY9FZ0Ul zr$^3cXy$1YYUTTFiq7Xr>(zH_huj{k!$B_}3l`?u3pH-1-zhxp;V&a-Vj?ChD|XO!x4LL`@0S*f z=MV9}A^z&n*&!2#b_t@8y+6rqd`qfkdrjb5Hq?(Fs$$wa@T<8C5;V+wYwR^PY7L4! zF);aGeV5YdyDEd8*Ay76mYvNvEJB;d$YSOxN5R?ByLzs7T65=$1b0fG>-^)wfXCVG zXASi09+oJRz5o5ndxG7Et($q^i}nroXow)A0OdDF9H(_GUb(@@+v|Sb!zUFNrKOIo zqfFF4v$=~jHV!?lmGly(32~pft+lbruT!9Xmy@S#U#i}4&kgYy5FUBPLp)7rppnX| z&d27GJ7E6wa>BKgnbNLvq*To}^P0+N=i6R{Zr5vGuE)py$9*~z^-|;Zb45sPVKb&% z)VT#dpGH!uZT9OW7{Ty-SB~Y8|IKCGQ>IToH?blM-wGdB6L8 z<^C;a%S+-POQZx#VHl=(bcoRNFJ#y`G%$fS8IQ(q6wt12nIo?WQh=X3elTYGLU zmspW7t~$oDv#il>^V#j*Eb-|3MSR^v?H;+oDeZR5^Ksr2+WVk4))*?TOAg*%XEtC` zS>*taWz}bST`ur^IbX&#Tq19G^ab;{<$GSAPTmu|E^*t9>g?AZ;)`Xhqa-W}*WZzh ze%75^C*kU<1JhHBx_V5S)NRc3f^ZLUcg4r;{UvTKGv5Ew_sf|3MTh@8X?_xmt8b2e z#*+(XmnQjsFx0r<*0p@8M98Po*EhU7y>YnV?sD+K)dM3B<{9OTrySWoRK`LOni99; zH3l__y(K%yUroBYz|JK)g4jRBUBJS`KO%P($QqTAsS}YqoS1N^WLeld*;z+JKRnjiUl{*V@XeA*a{g6ORZkBc z(JI|A@AKY4b1xNSMaAb6{Bac)gEytrbjN9ytdk=~rLHV9|17?4YT&(jM`LG1sFrgb z(L7??u{2@a_S8!oH&d8doLU!axc8iyuFr^aWd=hyjfS~Moaq_ z7kBOJ*T>Dr(P_i`fxGscx?PYJ8S&(>kLQ>h?j$T}exfLxe3m?~^Ob;9+lff-x{W$x zw%xFXnJIH4jbod=d#deupcyXXvP4l{{LxHDGEo?Mtfr^Peg(%r?}b$kr~zbeiRGQS zkk2)R%Tg}<;ejEWK~K*6T{N?aUA%+FU*7#r|4aD8!C8ysf&}{Zn|7q#fbh%zDrdM) zPT3z2fA6#B+MU7O)RMJIXJ>m|5Y}pUKSQaPh2O>HW4lWD?MOY}$;`LhB6Y)r5aZb; z?>fC1cEkO1=#$fLg#;pUwV!9+R-i;ny)^yOdH5{j=LxxkwX4L&mX2LsI>maR=%(w+ zFM>KvT9}e;z%O~>^4iy@A66zE@8){JV_4$VGiL@baS_of)e4f{CFNagnKsr%?C!SD zB_p2->=-D%(wmzAh3>!bae+`DY4PC1T}NWKYFXanVxb(aqd;3Ia_Bw9VBqc{ z;<9>A%4Wq(NZH{bdDMWAlID&gRvQV#$m~8I46_)^lXFF@=J&mr<-_}IChzzNk)*>s zYnFW8k}%GH|L2b#b8f`h7hk?Ih-=!enXsG~r8_j=(&FiM>&pw*Cs&*}wBpFY_4(Bq zX+h_`hroYCBtIId|7GFa zKCUBb+s!pnSs9fA%;!!0f5L7l) z+`#2%^?`5=zRz6RQ^LjHYLb+q<%hy7C>P;vKXC&~o9d~9P|Z!;He6)F&O+N$R0|Bb@T+X<=#i zN?zjq)ZQ9mWl<2lqfOuZ?Wc-MO7{;JA#|M*Uri0vF}xOIuCt4;=0?G+i5i>stn-w% z@`ptMzWgzHYGLo5JLg0#>iK+xx#vCZx7Q1@B)S|Nu?bd%hvbOZD4$F2=;hqGKI1$pS*=e_Y70t z9FH6Ba$AM>hV~lHMU*8S@9CIdVTWb*@A+Y%SMhGvc@ez}vh%?|Kp&p}Wy7S2jnM2))9>mn? zyLuZ446wgXB`uwzK

    83O*1PCwaDVrwp}->XiW#ez5j=m2#a@8qjg?%SqiVBqQYt z#wWy`dTAi4D`6BIUPGuwI>z<4NEw}Tm~wd79nZKGYkQjzJoyW+4VrO0KkBVx>Jm|6 zF?SEBB*Q%97sXNCF&;;}P0ERK{IdDf4en%~9uLP@%yEh&{)4>iVltP<1}ucUB=Y;p z_da#AAZu#eiUjbhSamU3JlJvH^TlcE{ONO~d!1Pt`}%b7-W3VpjDfBrersm%S&nw; zG%rrnd(GR_l#Vjs-eOb4h6Jwj+*v|d&OV>C@~nCVf>#Ty z=IQ51#$<$ejlEN7aE>oaAd6qi*5^>f^23tV635q}_lO83cf5qs-H3~(RlU7CpK9;@ zq#(;Pol8Z=gitY;v91}Cb39;0Nl%ZN`uETI^Li8BlRm$nKSng5Gc0%Yj|?ahw34vW zh@D%uDB|tx8uc6rJ(J4Cdsp;Y4_-VgT{NS(&k|>Ol)#tAP zzDt?w{^q2$_l&JXV+I~kPkSOTv&+e@gSaJz_$l+4bbIEfTU6yId!*O2QOf(5DddmK zD=eoRJ34;O=S|vE=Q%2KDQ`M-{IH+vibw}{k=qjCP%w$72@v0LLTE22ks;?=un z-(FWBZAZCROnbj>X=BM{dD*JFW!;~je&RdTXh>XG;&@WRMWpAa(3wdi!HtVB96Lep z&}ggW@N;lGE;@fOa3q9_-XCl*gahy))rU_Kf58QTzt>+0{NWN9(yM?ApeukPfZ5PK z1q+p=3fF1M7VaLUTy$iddQpnu$fEy@w2N+!*DktaG_vT1zD7~%7}cVaT5^SZRiq0y z$@VR9hqTiG)B$<|@ciLo`)%0+eTe~>00aRf0ptKw0+1YnYQU2VZ~ zCs+;0y*+>-z-EAS08Z+fRhvPZ$OPB{UneP z@xS62?q}IbDagYY0C#Kuu@~^y2jC3A&yw@6p6?Bi4KCgMaToA40Ra0xzq$^7Hhl#k zBild40Du=>fK>oB06$x{zf=A=ul!q&5rBSCfYX2V-eSAI1+o+W9qR(1yFb9Azq)U+ z?rC+^E0Ce$?_>i&uL1zhchPwGduLA;UqF`nzk>|`otglj{_39NwvS^(^IzEpfIb}n z?7#jk@2w+)3XtuLU(p7DF7@W zViJ7CNY%lGqK;8zwLOlRmIdLs4N3c{rhhoI1Xk+HYv7 ze43H&HpKnm^MsJ6e=}(Ou1@$<^;T3Q?8vN%v|kS{Z)HOO8hQY{X@Zs}`TXO{e*=rCf%+inXeFsPqKIsz zabywbM5Z;>5BLdy!|duF)3-JK)6C&ZehulrxQtY6ov|aX7qyxX3E-a13Ej74{nPB= z{OL+^qi?VmX}^M(bJPZKFAdxCLV&}ZnI2pE?yvr7TCaa!?gKUe zYfCMaYlC!)+35=cF7(}O(fob`I=RMtph-w$*mz%8qVKA|1?@@chm*W*#)mCC*i2>A7TazZA&=eS8^YCVEG&ph${ua z*7_bzW{mE?qyA~UV7;IwQ$%iFTTbG7e`{WE-_(#A!#FZeJet)y0QkiHTCGy2((wMy z`ls=L<23XIymkpX?X7t2+FHSh^`d>O=pT5)F<%ai$JV<43HqnW2JIj$q`cMqS<6aE z(ol=-Isn&)n>?2c;^@-&YR&tfq<@qX_6^V%6nz0(<2syJ$qD}v%ckl8;3c9p^-jb6 zr|BR0!hV61W$V~L1`PpQwM77uvw0xuvbr7R2s^egJ!O z!+1tzXGS&v?^Ie-=k&P$RQ)55=-abt4d*8k(RWBgmhFCk858|4rPonw{{EBok8;EQ zKF=qw6xyQg+*b$&KhA&*W>i9$T8Gt>_=y>g7u~TL+v?u4K0j2x&zByIZQumZWPd z`bXKQ!&wKPK60)f@cvy5yXEv;Bl^d)2ie8Ta{9KUe;g0)-(A7UZU8xP3|syoui$$| zb?brfn-6sVL%*-kmh_M1YL;mUNAIy)=0Uo2A%hy)dBDu&t?6g=QFl7{i{Gf zAnz^b+JHS#?9By&&Qg*BhND?z-BKFU3e}P&Mh!2 zW6a)xJ+7zeAMmVT7PmFtwMG5od2;CA&xxxNh7&r9EuRO}8eSMf)4#4#;kMS$F*BTP zQU559kFZyPQw{hVUF@s@(f9vG$`^+I2%XdC(H8ZO{D1tw zx$z&A+ZLC982=rowf`^|L1Su=hXZU?lZx&rdz5j`uQK3-Uaq8#naMs zZBhR?UgOk-J|MWJ&{Fv;OBL4n0Kr<&#FpY|X}Y$ke}6cqf>T#UI;{V&;Rj5={sa0~ zYN;Muny#(sANKLVjoKx3ATekeaszB%6X!^%H z=$HCkGdb(~dpH5kf`I-68~R$^i2mi+z}IYA+DiGyKKj3x zIXCBzZHS9KTWvq;YGNb$=ZEKbUTCv**^)GEMgO+bI9vAdym)rz{XkcEu3N8$`mb#R zPPRmsElJZB^pE{M{B|fOuXDKfkBxCZ=qjTz-Ph{hwI#Z2Nt!=h|JdhijWa;-`?D>P zH(i=7O!PmLE*`u2Firm_>mTRkXHG03@ysSpUb%2aH3#%##6)4y~1HFC$=)g$-wQWG~U;Ve-{?V>E>ElbQKMLWTS;WnzZvJ7W`&#|~ zkTbykwDOO2KKf(ex$UiS?TjdAcg_cGr*6%MksUxBYy%#$X=hE^>7S&3?CV*Ymyqu` zxWAX)hVa}sZT8FlC(tQN-vNMlK7aM!bQ?hPzu3C5oW%WDt#t*jC}V4_uU41a8I}2l z&mn$q0Q`<%ljXRjaen9Wk9x=XS3H})wd#ACEoDBcX3NiqPCs?)y$$uG z{|@@cc3lp9tnmCM>nSDV{yi1s`#cUV;?pa;k>A@xq0h(OIuA|$)97`}%5Ts;`UG5V zEgRsZ{_$J|{2mADsilB(>fjSi8tWF5mXnLgrEaBU?2ZZ&&)Y2c(ui_e`O%#l9IN-A zf(~2sO>jsz{&&!SIk;687XiT9NK2pu(xE>!`c?c2*E^_V#;CGA)~A(yCsxXPV{t(D zTmb*Ih7EAC{Qn9%;}i{Oi!&y0N7|`_OJdqrCsKDDqsxB!Eb+} z{%u*+GqZSr=QO8n;BWb_ZwshvX`w%S^AVz5_hN04g{{7nQ%i`v0bX ztn;zlb5Qpv^Kc~O?XFLkPZ}uKZte}3U0nhzmM^-GP4Qj6bI1wM{ieiDbMtT2J%m0g<8ZvBs zIrSS|KS1v&+hhP9PUy3_I3QmEfK-4+bwN{g}*j%;?=4$hTi}bk$mM zfeuN47bpi-0naY~Rn}V@YsGQz2A z?S-ZCf_45cS?(L!3(zS6@aV5zS<)*jb>VA}rCdWf|H@&Y7smyZzc#?O4LkrDO8&~a zW<(p%-40;;UmIw#4IBsA{nYV2Bi%OVIq={JQ1aIfShfQ^qa^^~r_Ad$N4KoT1zr>Y znmtbhX;^6=|D-rLhSq0QuD??};0xD|fB3iNej^(?3bcy-PC9J~t-zxpK+bQZm)5Rd z@Z2@4mdNsVO#}R5U9b+IRreVK{?^tVJNR+keh)z1x7dGIeYTWt;2qDLN&;X@)>Qn~$U=|C1^0IszGJIDYYrvS97pWg3iA0QJh00V#@dKNk4_ao|$yO7Te0KVT* zH$R$Ykdp=goCs!ZfZ+UNl5rN$L0QdmlJSZbM|7y>(f!0+3 zgId7y-z1Gl0Az{hlBojV`GmjXJQD7W3J1^u_*=&}qC-wS0{NmX;GWb)062E|Vds`Z zUbMOf_gS3-@CLx|XK`e&EvIDEmhgb=1psh<8NXu~32+qv_d{^vn^rhRe-D7;wVeRy z_l{>|3brK~|8Bg(_icCqdIG2bOoDG*;u=(djzVDsd^;!BShwf^e)k^W5dOwz+6vVA zI{@QC8Z&?q0KEYImhIoo0RGa;k^~y_eTCDI2ttDXO#tAc3&ZPr5hxhu`4$0#1mRD6 zK#fk9Acy*z5TLye_!{P-g}(;t5LD5^I$tB?)54v;hI44)T7(o@xRxSXu$G0IZ()B# zP=}r%bTC{?Eyj|-a9wr;LCrAdTY74Sly6~bh5_HgRF1v{sRYnvPvwvC0xejun}m_q*^2&@+d0t4vZLzq5@1UCrRBOe%O7_LV?Fw{g?q8@v|V8d`d zc7frh!a4Qn6=-Idhf+U1yJ4L`?;#jizB7yOE#mKuCYWl`eW zdt{*wJ3a=Ibm(5w{Tw`+AS4N_=y|9BKZ(wr1?&2|gCVR75CFhMjR`+=0e;d2eQ^Sy z3-r#@M z0MHj0$E37*2xj*@h==pf%K-2^-#WcA&GZ*|3A8E$YysfpeiED$*am=W3%{Ig08Kcr zWe$LI4b1e)iFdalkC_0!giQb)xbBw*zzN=(g9G=_ngaY3tA~7h0~`Wq4$Z9*7x$6( z`;kI`{44-I{Q|txYreBC}8vnFA&T|U1h8zHI2LNo7XnFmr_lrQI z2q$F#_&NjpPChPJA9v@33;+-69p~l0)3>jC8F~J6CEIZ3WF>j@Kn3;OcKl|FGkl)| zzmv}9K5di%TXq2Hc>!>p>O0=?+0Ka8`*;kVHHT-89f+$Soh(aQdgfdz(Anbp0Mdpq z;=Q%`ryJ@}f4B=tH=%Kx zWS}qW=EwkW^Z>xMvqtTn_WWn?Pm@E|<7(=@e;O@K+za77%Y7t>yT1v1RJr_2{!tG2 z{RCh5-UW;2kYd~2q!~aQT~>ICj{7ETlS+=2Js&7r_E z^yg>V-ZjMA8vN7ef#38&`8DUlv-?=655GH)0rFi-pEoPNTbqBR0eM-!s*L3`m+)++ zsm8@k*}!)CG64Bty@%f$YARj5_dkMvnhXMc%BXccE4Fa@L}gPpfb)rU^&tEn)?D5( z{*U4x^FlkoI+B$OzdvUHXCXDglP1juAf8JTaT~?;Bl$=Au+PitcN;fAnQ4NjWpw<< zHxai{TtAwBq|pPuHNwhu`@bqu8O}6h!dEgK|4*32V~FEt@Q-x9e%W*%0l&+lIh<)3 z$gN$IY6mzgekcBSZG}VbSh(sO%8h`*+u|1ADT!5lEo`!sch!#Tgqc!2tEJhXq3 z%;GS6_p|u7pTS!D=j+~d`v?5<1CQm*_+<3%XYs#nGi&{ynWjv~!Px(yt`7l!4;b;t z?D@~&AIm<@eK&RCcT4b_B~0jl1N>8m01#&{lXwhq{0#nCwf$?CVEhBJV#3!+y7A9E zCh-{J_|g0$KeundL?;Uu3-iHC>G+ra9r$162MZo7T(~a6!grWQ(D6?I|IOZ;`Xlv^ zc3;j~wMSh`Z^HI-f!}&()IoSfb8X;9@Q-{fnp;Yivex90_}v~;I19W9UbfJ5PrE~W zDS&3}J8W(KaV|e`Zv{(z9a^!Vj(M2Zdng-a8sGGHczzn7DcRM%=QRH`o1F#ic3gA? zSyaeECy&NB+;Lt=yY~EdCVZeD4?Wv;zu~zalXP`_)8eqge|AlkkE1JYnU$nqI3tng2xuQl&D7HF!kTPqLr z31WJl2fWAe5KHS|zXJcb-m_v!SyO!-nq9DTJ|*xU4M0o7@cy&;FDj}bT^*Q@ap?Fs z*udNw1|f|oK$HIKKa>CTJ5{W-b2Qz31b%ukWVn$R5MLjFX?yrH_{Z-quUJ~vTz@$8 zMp$g}5%3=fK$GEj_aDjs)68nBkB5dVV|p0Sx~WM<8AJelxUb;=1H3HF|F^W>$2H7{ z8Pz1Nb)Y{4t#81H76#AJH@&WedPx0lz_p{hbKt zCoJ2d2!i_!964F_J-Ja`^?GA@7}8WRIn2fDi3}VOjVEc&61) z=&#HXy*CsL;KlkN0Dx(`0PktE{Kz}@+13NFRo)x&+*la$7zcp+`FCs8wgvRv5MzfIcG5!LY5?eG&rCn9@$Ns!a}+zYb1E&+f#b$80O(`f zn)ZNYJOyApz;`~3oZ^QaJU|!DBjH>c`r2|z?@s|2`X>%$hqfP?7HCDAzH z2*AoZ6Z+!dT zULCzTwc*;k0PS9T+C`@Z@{pj(siFL6a;=jyg@6m>PDKcMpdym^rYC9w&@LvRo+$x2 zQqR?(>6y$yHOEWQpCj?L>(uZZ337yQ!@FRoXxbD?iH z?gz%b=Rx2T0Otp>$`8(suw+XR4{d%$L)tOSF8vL8uLOQ@4}25;N;Dp^JTz%a5C_*X z8!fAxrk}={#KwrJ6 zrqV@|b5r+1@Nu0E-*%_Zo9=fR{Qj=50nY;H;xw9;8U45xk82H$0pit?Dg6 zu;PQB^R$|ph5=3M>2&~c1OU*s8l{`|yeax=@tV4$f5~B3e`v~=HhMclKU(bb)%9E9 zw?R{R;(JcfPs?i^>@UW3a7I^2Nev0U?u=ww=MMq+w$gAiyK|a;%qwyWbLXz8Forsa zK^p=b*w(T%=hPbX!vMR<3(y^)(e|ogn%1Bn^Jr>s-4y6M zHKYZ?IF9QJ^~K0W-Zd7V7skru$M=l=hn7RXix!vu4&!M9*atP6{u#61ttEfV z^K261{oXM<8sEq8;*~aCM^h4d`Mw4$-_tum@Gy6$8+Bp4aKTv*WHbpn>eQVN> zd+!-tyBYK&u>3;(sX?Q!se5bDkNeB>-ZHK~8SN*<`V(mG3c%7n;?|;nz7=C9Y3$>f zjcc_1!tt0m0QMg;02*y0=%2S1{Wq^O-rJB3{b<#}jnb9_v{8N8;l72QPDa05gMOTc zV0JOtixy2A0|31^X8+;x$9@m9y#?rpJx-lr|G91~547_GV1JG&51f)ej>XVF41NBY zUE5*57z3Jc-dl(!|Jr`EFN3&sI9f_S+OLjc5!JsddRsY(W96nU95-XXjsZ=p>1nT} zAAMKz8N{dJVMafWX|b=~5OC~{zL&VShSe+oa}8;3&}f~5bl}{5&xZ7~q6231vr1c2 z@lXynQh}44pmam55zjDVIB;^xQ4=X|3pJ3AU@7%)mwYP`Fcz9;%32|$;IT1 z3B}~ZF~!t9J~%(efJR2oaSf$jUEh#aM&Vi>zSBc9^JhdCE6;HarA4&Uc!Kn3OFjUN zmT7p-3LVXjgJl)hP?}{kG@2W`11_9rc?i&4TACaGDdd6uvBtlxt0_F*Xi({>u( zH9+-fFdfA{K5AK{gEW_o`YUua1TH?B)DUS@Q>=>}5fV`43K6Mtrn>JDM0{s@KQ2DZ^}Fu@Ny0N-fI2@eNW;zr_Je*n=!@$IHnj`J zDM!FZ>nMbyA?y!#^gm%Um--X}K5WO(hX(Uur7gpQL zkXE%mM@@$y4Xy3QI;T1LH5RuDaQFkTRQ4erFF*`HW4PFPmH;^UnQ;&Ak?*>^t*4Yw z&ws=-AQ=Jfle?c*MP2~k5ZrHV32U`XXh#|t$^qUjrcaALH!Zo4R@~RcVEzhf!S64~ zS012VJJizrX*A!sRz;43?<&yq1i#T9>e(cO34m09dU4s!AL+n(1@vEPfcrlP*Og89 zJ-WerYW&9X$31hXV;Z21xH*=RIKRSZF8AKus>aUGA5YT)ov^{Y653j4fN`{R4eu?@AMGB? zWWx*3^=OcX354sFIr{f4%^z_rg>&*7UbyFy9>2<(NCEvy(si zJT|;8Q|j{%`j3XZJZbqgyt9-4V(0JeFZTQO>}8PWn1=b%!tCVV*xHJ--FI!HG313~ zQ=FUqP6sW`e^n!E%I{#EO|Aal7*|dunLi+=2oo`;%FK;yayK}RuF<%({uenq6M;b0P zq@l6=X*gNE<2qU+eSj;FS6%yCD}!P1tX}_`-Tbk>YsB{$`?QKQ-s$h~d=WsMo?4ne z`XyocqsK+}+lM|+`ri--^$dPZ9^_GmZSuQv(F{7U zPb=RTZdRW`dRqN}byTDEWCMCiAdLMJscPY2!**f65AVk!1EdL>>}OzYcJUMslx%k9Ra9o9*pXDJQok! z8uf2$#0wAsr0W7eonOW^6WVqDR3&*BzAba&a3%R7=bOJK`bO1`PmvcoQAg;1u4n@Uf6kK-}C==#H`qr0^CjPj?wN8ebyu)W1+wfen7d(Ue6 z*RQJU(nH!qtfs$v>nr`2Q|kP)jzL<9<@`PLV6q8T8hMLXJn>x0;bqlcAn z2Gc^D5>i{C-dH{q)6ieFIPBq0lcc~rYyh+}2u)qIc$fy$&VU5iP>`fBVM2@|42cN-O0syWPgR>^8F?4oo!w0oSf&5>~CQ{PFAhI zq`QZ;vz_$<7iasC{eA4+`|D_T6wkC?VasFyFRrzXb(I_)#|d26Pj`jA-ac? zhYwY}C}IyES1XW20>&K_hP?)rr#0evu~_y}g~Oo0FH*0{gl4bruOWS@(9VHzY(;Hn#V&Ur;AnNy!Bm9@*d8 z-O$+!Wa9RXSxHGxr%|@Z@5ufR)(hP2zrCtu7c!8m%b{WZT5|NXYRT2HjHMfjfGda=pOVcu_7aa?`wq!>kK`nX{#0P>}{bXg$9qlCz^(1ZV7q~2zgu;bI*xp?d;!3)E zy1Kf!c}P0AxJlL;k>nI7sD316Wq~S4UmL^TZsKG~L%Wgvm)a}JD<~+djF44OQC5{z zRv z$TQAb&0gMNgtdaAtc`<>5(wO0O%}wjBCD+CV5cH)t)OD9P8GPIpdebGTm$pdlB;K? zXy#B=er?4d0PQS6XaSI<5MfFfL(6SWjDuF&3|et>2$>Q3#8~(>85>c!=-W}z0D|}* D!FW0x literal 0 HcmV?d00001 diff --git a/src/DuckListU.pas b/src/DuckListU.pas new file mode 100644 index 0000000..7827a36 --- /dev/null +++ b/src/DuckListU.pas @@ -0,0 +1,337 @@ +// *************************************************************************** +// +// Delphi MVC Framework +// +// Copyright (c) 2010-2016 Daniele Teti and the DMVCFramework Team +// +// https://github.com/danieleteti/delphimvcframework +// +// *************************************************************************** +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// *************************************************************************** + +unit DuckListU; + +interface + +uses + RTTI, + Classes, + // superobject, + Generics.Collections, + SysUtils, + TypInfo; + +type + TDuckTypedList=class; + + TdormObjectStatus=(osDirty=0, osClean, osUnknown, osDeleted); + + EdormException=class(Exception) + + end; + + EdormValidationException=class(EdormException) + + end; + + TdormEnvironment=(deDevelopment, deTest, deRelease); + TdormObjectOwner=(ooItself, ooParent); + TdormSaveType=(stAllGraph, stSingleObject); + TdormRelations=set of (drBelongsTo, drHasMany, drHasOne); + TdormFillOptions=set of (CallAfterLoadEvent); + + IList=interface + ['{2A1BCB3C-17A2-4F8D-B6FB-32B2A1BFE840}'] + function Add(const Value: TObject): Integer; + procedure Clear; + function Count: Integer; + function GetItem(index: Integer): TObject; + end; + + TdormListEnumerator=class(TEnumerator) + protected + FPosition: Int64; + FDuckTypedList: TDuckTypedList; + + protected + function DoGetCurrent: TObject; override; + function DoMoveNext: boolean; override; + + public + constructor Create(ADuckTypedList: TDuckTypedList); + end; + + TSortingType=(soAscending, soDescending); + + IWrappedList=interface + ['{B60AF5A6-7C31-4EAA-8DFB-D8BD3E112EE7}'] + function Count: Integer; + function GetItem(const index: Integer): TObject; + procedure Add(const AObject: TObject); + procedure Clear; + function GetEnumerator: TdormListEnumerator; + function WrappedObject: TObject; + procedure Sort(const PropertyName: string; Order: TSortingType=soAscending); + function GetOwnsObjects: boolean; + procedure SetOwnsObjects(const Value: boolean); + property OwnsObjects: boolean read GetOwnsObjects write SetOwnsObjects; + end; + + TDuckTypedList=class(TInterfacedObject, IWrappedList) + protected + FCTX: TRTTIContext; + FObjectAsDuck: TObject; + FAddMethod: TRttiMethod; + FClearMethod: TRttiMethod; + FCountProperty: TRttiProperty; + FGetItemMethod: TRttiMethod; + FGetCountMethod: TRttiMethod; + function Count: Integer; + function GetItem(const index: Integer): TObject; + procedure Add(const AObject: TObject); + procedure Clear; + function WrappedObject: TObject; + procedure QuickSort(List: IWrappedList; L, R: Integer; SCompare: TFunc); overload; + + procedure QuickSort(List: IWrappedList; SCompare: TFunc); overload; + procedure Sort(const PropertyName: string; Order: TSortingType=soAscending); + + public + constructor Create(AObjectAsDuck: TObject); + destructor Destroy; override; + function GetEnumerator: TdormListEnumerator; + function GetOwnsObjects: boolean; + procedure SetOwnsObjects(const Value: boolean); + property OwnsObjects: boolean read GetOwnsObjects write SetOwnsObjects; + class function CanBeWrappedAsList(const AObjectAsDuck: TObject): boolean; + end; + +function WrapAsList(const AObject: TObject): IWrappedList; + +implementation + +uses System.Math, + RTTIUtilsU; + +constructor TdormListEnumerator.Create(ADuckTypedList: TDuckTypedList); +begin + inherited Create; + FDuckTypedList := ADuckTypedList; + FPosition := -1; +end; + +function TdormListEnumerator.DoGetCurrent: TObject; +begin + if FPosition>-1 then + Result := FDuckTypedList.GetItem(FPosition) + else + raise Exception.Create('Enumerator error: Call MoveNext first'); +end; + +function TdormListEnumerator.DoMoveNext: boolean; +begin + if FPositionnil)and(FCTX.GetType(AObjectAsDuck.ClassInfo).GetMethod('Clear')<>nil) + +{$IF CompilerVersion >= 23} + and(FCTX.GetType(AObjectAsDuck.ClassInfo).GetIndexedProperty('Items').ReadMethod<>nil) + +{$IFEND} + and((FCTX.GetType(AObjectAsDuck.ClassInfo).GetMethod('GetItem')<>nil)or(FCTX.GetType(AObjectAsDuck.ClassInfo).GetMethod('GetElement')<> + nil))and(FCTX.GetType(AObjectAsDuck.ClassInfo).GetProperty('Count')<>nil) + +end; + +procedure TDuckTypedList.Clear; +begin + FClearMethod.Invoke(FObjectAsDuck, []); +end; + +function TDuckTypedList.Count: Integer; +begin + if Assigned(FCountProperty) then + Result := FCountProperty.GetValue(FObjectAsDuck).AsInteger + else + Result := FGetCountMethod.Invoke(FObjectAsDuck, []).AsInteger; + +end; + +constructor TDuckTypedList.Create(AObjectAsDuck: TObject); +begin + inherited Create; + FObjectAsDuck := AObjectAsDuck; + FAddMethod := FCTX.GetType(AObjectAsDuck.ClassInfo).GetMethod('Add'); + if not Assigned(FAddMethod) then + raise EdormException.Create('Cannot find method "Add" in the duck object'); + FClearMethod := FCTX.GetType(AObjectAsDuck.ClassInfo).GetMethod('Clear'); + if not Assigned(FClearMethod) then + raise EdormException.Create('Cannot find method "Clear" in the duck object'); + FGetItemMethod := nil; + +{$IF CompilerVersion >= 23} + FGetItemMethod := FCTX.GetType(AObjectAsDuck.ClassInfo).GetIndexedProperty('Items').ReadMethod; + +{$IFEND} + if not Assigned(FGetItemMethod) then + FGetItemMethod := FCTX.GetType(AObjectAsDuck.ClassInfo).GetMethod('GetItem'); + if not Assigned(FGetItemMethod) then + FGetItemMethod := FCTX.GetType(AObjectAsDuck.ClassInfo).GetMethod('GetElement'); + if not Assigned(FGetItemMethod) then + raise EdormException.Create + ('Cannot find method Indexed property "Items" or method "GetItem" or method "GetElement" in the duck object'); + FCountProperty := FCTX.GetType(AObjectAsDuck.ClassInfo).GetProperty('Count'); + if not Assigned(FCountProperty) then + begin + FGetCountMethod := FCTX.GetType(AObjectAsDuck.ClassInfo).GetMethod('Count'); + if not Assigned(FGetCountMethod) then + + raise EdormException.Create('Cannot find property/method "Count" in the duck object'); + end; +end; + +destructor TDuckTypedList.Destroy; +begin + + inherited; +end; + +function TDuckTypedList.GetItem(const index: Integer): TObject; +begin + Result := FGetItemMethod.Invoke(FObjectAsDuck, [index]).AsObject; +end; + +function TDuckTypedList.GetOwnsObjects: boolean; +begin + Result := TRTTIUtils.GetProperty(FObjectAsDuck, 'OwnsObjects').AsBoolean +end; + +function TDuckTypedList.WrappedObject: TObject; +begin + Result := FObjectAsDuck; +end; + +function WrapAsList(const AObject: TObject): IWrappedList; +begin + try + Result := TDuckTypedList.Create(AObject); + except + Result := nil; + end; +end; + +procedure TDuckTypedList.QuickSort(List: IWrappedList; L, R: Integer; SCompare: TFunc); +var + I, J: Integer; + p: TObject; +begin + { 07/08/2013: This method is based on QuickSort procedure from + Classes.pas, (c) Borland Software Corp. + but modified to be part of TDuckListU unit. It implements the + standard quicksort algorithm, + delegating comparison operation to an anonimous. + The Borland version delegates to a pure function + pointer, which is problematic in some cases. } + repeat + I := L; + J := R; + p := List.GetItem((L+R) shr 1); + repeat + while SCompare(TObject(List.GetItem(I)), p)<0 do + Inc(I); + while SCompare(TObject(List.GetItem(J)), p)>0 do + Dec(J); + if I<=J then + begin + TRTTIUtils.MethodCall(List.WrappedObject, 'Exchange', [I, J]); + Inc(I); + Dec(J); + end; + until I>J; + if L=R; +end; + +procedure TDuckTypedList.QuickSort(List: IWrappedList; SCompare: TFunc); +begin + QuickSort(List, 0, List.Count-1, SCompare); +end; + +function CompareValue(const Left, Right: TValue): Integer; +begin + if Left.IsOrdinal then + begin + Result := System.Math.CompareValue(Left.AsOrdinal, Right.AsOrdinal); + end + else if Left.Kind=tkFloat then + begin + Result := System.Math.CompareValue(Left.AsExtended, Right.AsExtended); + end + else if Left.Kind in [tkString, tkUString, tkWString, tkLString] then + begin + Result := CompareText(Left.AsString, Right.AsString); + end + else + begin + Result := 0; + end; +end; + +procedure TDuckTypedList.SetOwnsObjects(const Value: boolean); +begin + TRTTIUtils.SetProperty(FObjectAsDuck, 'OwnsObjects', Value); +end; + +procedure TDuckTypedList.Sort(const PropertyName: string; Order: TSortingType); +begin + if Order=soAscending then + QuickSort(self, + function(Left, Right: TObject): Integer + begin + Result := CompareValue(TRTTIUtils.GetProperty(Left, PropertyName), TRTTIUtils.GetProperty(Right, PropertyName)); + end) + else + QuickSort(self, + function(Left, Right: TObject): Integer + begin + Result := -1*CompareValue(TRTTIUtils.GetProperty(Left, PropertyName), TRTTIUtils.GetProperty(Right, PropertyName)); + end); +end; + +end. diff --git a/src/EventBus.Core.pas b/src/EventBus.Core.pas new file mode 100644 index 0000000..be9a8a4 --- /dev/null +++ b/src/EventBus.Core.pas @@ -0,0 +1,362 @@ +{ ******************************************************************************* + Copyright 2016-2019 Daniele Spinetti + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + ******************************************************************************** } + +unit EventBus.Core; + +interface + +uses + System.SyncObjs, EventBus.Subscribers, Generics.Collections, + System.SysUtils, System.Classes, Router4D.Props; + +type + + TEventBus = class(TInterfacedObject, IEventBus) + var + FTypesOfGivenSubscriber: TObjectDictionary>; + FSubscriptionsOfGivenEventType + : TObjectDictionary>; + FCustomClonerDict: TDictionary; + FOnCloneEvent: TCloneEventCallback; + procedure Subscribe(ASubscriber: TObject; + ASubscriberMethod: TSubscriberMethod); + procedure UnsubscribeByEventType(ASubscriber: TObject; AEventType: TClass); + procedure InvokeSubscriber(ASubscription: TSubscription; AEvent: TObject); + function GenerateTProc(ASubscription: TSubscription; + AEvent: TObject): TProc; + function GenerateThreadProc(ASubscription: TSubscription; AEvent: TObject) + : TThreadProcedure; + protected + procedure SetOnCloneEvent(const aCloneEvent: TCloneEventCallback); + function CloneEvent(AEvent: TObject): TObject; virtual; + procedure PostToSubscription(ASubscription: TSubscription; AEvent: TObject; + AIsMainThread: Boolean); virtual; + public + constructor Create; virtual; + destructor Destroy; override; + procedure RegisterSubscriber(ASubscriber: TObject); virtual; + function IsRegistered(ASubscriber: TObject): Boolean; + procedure Unregister(ASubscriber: TObject); virtual; + procedure Post(AEvent: TObject; const AContext: String = ''; + AEventOwner: Boolean = true); virtual; + property TypesOfGivenSubscriber: TObjectDictionary < TObject, + TList < TClass >> read FTypesOfGivenSubscriber; + property SubscriptionsOfGivenEventType: TObjectDictionary < TClass, + TObjectList < TSubscription >> read FSubscriptionsOfGivenEventType; + property OnCloneEvent: TCloneEventCallback write SetOnCloneEvent; + procedure AddCustomClassCloning(const AQualifiedClassName: String; + const aCloneEvent: TCloneEventMethod); + procedure RemoveCustomClassCloning(const AQualifiedClassName: String); + end; + +implementation + +uses + System.Rtti, +{$IF CompilerVersion >= 28.0} + System.Threading, +{$ENDIF} + RTTIUtilsU; + +var + FMREWSync: TMultiReadExclusiveWriteSynchronizer; + + { TEventBus } + +constructor TEventBus.Create; +begin + inherited Create; + FSubscriptionsOfGivenEventType := TObjectDictionary < TClass, + TObjectList < TSubscription >>.Create([doOwnsValues]); + FTypesOfGivenSubscriber := TObjectDictionary < TObject, + TList < TClass >>.Create([doOwnsValues]); + FCustomClonerDict := TDictionary.Create; +end; + +destructor TEventBus.Destroy; +begin + FreeAndNil(FSubscriptionsOfGivenEventType); + FreeAndNil(FTypesOfGivenSubscriber); + FreeAndNil(FCustomClonerDict); + inherited; +end; + +procedure TEventBus.AddCustomClassCloning(const AQualifiedClassName: String; + const aCloneEvent: TCloneEventMethod); +begin + FCustomClonerDict.Add(AQualifiedClassName, aCloneEvent); +end; + +function TEventBus.CloneEvent(AEvent: TObject): TObject; +var + LCloneEvent: TCloneEventMethod; +begin + if FCustomClonerDict.TryGetValue(AEvent.QualifiedClassName, LCloneEvent) then + Result := LCloneEvent(AEvent) + else if Assigned(FOnCloneEvent) then + Result := FOnCloneEvent(AEvent) + else + Result := TRTTIUtils.Clone(AEvent); +end; + +function TEventBus.GenerateThreadProc(ASubscription: TSubscription; + AEvent: TObject): TThreadProcedure; +begin + Result := procedure + begin + if ASubscription.Active then + begin + ASubscription.SubscriberMethod.Method.Invoke(ASubscription.Subscriber, + [AEvent]); + end; + end; +end; + +function TEventBus.GenerateTProc(ASubscription: TSubscription; + AEvent: TObject): TProc; +begin + Result := procedure + begin + if ASubscription.Active then + begin + ASubscription.SubscriberMethod.Method.Invoke(ASubscription.Subscriber, + [AEvent]); + end; + end; +end; + +procedure TEventBus.InvokeSubscriber(ASubscription: TSubscription; + AEvent: TObject); +begin + try + ASubscription.SubscriberMethod.Method.Invoke(ASubscription.Subscriber, + [AEvent]); + except + on E: Exception do + begin + raise Exception.CreateFmt + ('Error invoking subscriber method. Subscriber class: %s. Event type: %s. Original exception: %s: %s', + [ASubscription.Subscriber.ClassName, + ASubscription.SubscriberMethod.EventType.ClassName, E.ClassName, + E.Message]); + end; + end; +end; + +function TEventBus.IsRegistered(ASubscriber: TObject): Boolean; +begin + FMREWSync.BeginRead; + try + Result := FTypesOfGivenSubscriber.ContainsKey(ASubscriber); + finally + FMREWSync.EndRead; + end; +end; + +procedure TEventBus.Post(AEvent: TObject; const AContext: String = ''; + AEventOwner: Boolean = true); +var + LSubscriptions: TObjectList; + LSubscription: TSubscription; + LEvent: TObject; + LIsMainThread: Boolean; +begin + FMREWSync.BeginRead; + try + try + LIsMainThread := MainThreadID = TThread.CurrentThread.ThreadID; + + FSubscriptionsOfGivenEventType.TryGetValue(AEvent.ClassType, + LSubscriptions); + + if (not Assigned(LSubscriptions)) then + Exit; + + for LSubscription in LSubscriptions do + begin + + if not LSubscription.Active then + continue; + + if ((not AContext.IsEmpty) and (LSubscription.Context <> AContext)) then + continue; + + LEvent := CloneEvent(AEvent); + PostToSubscription(LSubscription, LEvent, LIsMainThread); + end; + finally + if (AEventOwner and Assigned(AEvent)) then + AEvent.Free; + end; + finally + FMREWSync.EndRead; + end; +end; + +procedure TEventBus.PostToSubscription(ASubscription: TSubscription; + AEvent: TObject; AIsMainThread: Boolean); +begin + + if not Assigned(ASubscription.Subscriber) then + Exit; + + case ASubscription.SubscriberMethod.ThreadMode of + Posting: + InvokeSubscriber(ASubscription, AEvent); + Main: + if (AIsMainThread) then + InvokeSubscriber(ASubscription, AEvent) + else + TThread.Queue(nil, GenerateThreadProc(ASubscription, AEvent)); + Background: + if (AIsMainThread) then +{$IF CompilerVersion >= 28.0} + TTask.Run(GenerateTProc(ASubscription, AEvent)) +{$ELSE} + TThread.CreateAnonymousThread(GenerateTProc(ASubscription, + AEvent)).Start +{$ENDIF} + else + InvokeSubscriber(ASubscription, AEvent); + Async: +{$IF CompilerVersion >= 28.0} + TTask.Run(GenerateTProc(ASubscription, AEvent)); +{$ELSE} + TThread.CreateAnonymousThread(GenerateTProc(ASubscription, AEvent)).Start; +{$ENDIF} + else + raise Exception.Create('Unknown thread mode'); + end; + +end; + +procedure TEventBus.RegisterSubscriber(ASubscriber: TObject); +var + LSubscriberClass: TClass; + LSubscriberMethods: TArray; + LSubscriberMethod: TSubscriberMethod; +begin + FMREWSync.BeginWrite; + try + LSubscriberClass := ASubscriber.ClassType; + LSubscriberMethods := TSubscribersFinder.FindSubscriberMethods + (LSubscriberClass, true); + for LSubscriberMethod in LSubscriberMethods do + Subscribe(ASubscriber, LSubscriberMethod); + finally + FMREWSync.EndWrite; + end; +end; + +procedure TEventBus.RemoveCustomClassCloning(const AQualifiedClassName: String); +begin + // No exception is thrown if the key is not in the dictionary + FCustomClonerDict.Remove(AQualifiedClassName); +end; + +procedure TEventBus.SetOnCloneEvent(const aCloneEvent: TCloneEventCallback); +begin + FOnCloneEvent := aCloneEvent; +end; + +procedure TEventBus.Subscribe(ASubscriber: TObject; + ASubscriberMethod: TSubscriberMethod); +var + LEventType: TClass; + LNewSubscription: TSubscription; + LSubscriptions: TObjectList; + LSubscribedEvents: TList; +begin + LEventType := ASubscriberMethod.EventType; + LNewSubscription := TSubscription.Create(ASubscriber, ASubscriberMethod); + if (not FSubscriptionsOfGivenEventType.ContainsKey(LEventType)) then + begin + LSubscriptions := TObjectList.Create(); + FSubscriptionsOfGivenEventType.Add(LEventType, LSubscriptions); + end + else + begin + LSubscriptions := FSubscriptionsOfGivenEventType.Items[LEventType]; + if (LSubscriptions.Contains(LNewSubscription)) then + raise Exception.CreateFmt('Subscriber %s already registered to event %s ', + [ASubscriber.ClassName, LEventType.ClassName]); + end; + + LSubscriptions.Add(LNewSubscription); + + if (not FTypesOfGivenSubscriber.TryGetValue(ASubscriber, LSubscribedEvents)) + then + begin + LSubscribedEvents := TList.Create; + FTypesOfGivenSubscriber.Add(ASubscriber, LSubscribedEvents); + end; + LSubscribedEvents.Add(LEventType); +end; + +procedure TEventBus.Unregister(ASubscriber: TObject); +var + LSubscribedTypes: TList; + LEventType: TClass; +begin + FMREWSync.BeginWrite; + try + if FTypesOfGivenSubscriber.TryGetValue(ASubscriber, LSubscribedTypes) then + begin + for LEventType in LSubscribedTypes do + UnsubscribeByEventType(ASubscriber, LEventType); + FTypesOfGivenSubscriber.Remove(ASubscriber); + end; + // else { + // Log.w(TAG, "Subscriber to unregister was not registered before: " + subscriber.getClass()); + // } + finally + FMREWSync.EndWrite; + end; +end; + +procedure TEventBus.UnsubscribeByEventType(ASubscriber: TObject; + AEventType: TClass); +var + LSubscriptions: TObjectList; + LSize, I: Integer; + LSubscription: TSubscription; +begin + LSubscriptions := FSubscriptionsOfGivenEventType.Items[AEventType]; + if (not Assigned(LSubscriptions)) or (LSubscriptions.Count < 1) then + Exit; + LSize := LSubscriptions.Count; + for I := LSize - 1 downto 0 do + begin + LSubscription := LSubscriptions[I]; + // Notes: In case the subscriber has been freed but it didn't unregister itself, calling + // LSubscription.Subscriber.Equals() will cause Access Violation, so we use '=' instead. + if LSubscription.Subscriber = ASubscriber then + begin + LSubscription.Active := false; + LSubscriptions.Delete(I); + end; + end; +end; + +initialization + +FMREWSync := TMultiReadExclusiveWriteSynchronizer.Create; + +finalization + +FMREWSync.Free; + +end. diff --git a/src/EventBus.Subscribers.pas b/src/EventBus.Subscribers.pas new file mode 100644 index 0000000..5f8bbbe --- /dev/null +++ b/src/EventBus.Subscribers.pas @@ -0,0 +1,241 @@ +{ ******************************************************************************* + Copyright 2016-2019 Daniele Spinetti + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + ******************************************************************************** } + +unit EventBus.Subscribers; + +interface + +uses + System.RTTI, Router4D.Props; + +type + + TSubscriberMethod = class(TObject) + private + FEventType: TClass; + FThreadMode: TThreadMode; + FMethod: TRttiMethod; + FContext: string; + procedure SetEventType(const Value: TClass); + procedure SetMethod(const Value: TRttiMethod); + procedure SetThreadMode(const Value: TThreadMode); + procedure SetContext(const Value: String); + public + constructor Create(ARttiMethod: TRttiMethod; AEventType: TClass; + AThreadMode: TThreadMode; const AContext: String = ''; + APriority: Integer = 1); + destructor Destroy; override; + property EventType: TClass read FEventType write SetEventType; + property Method: TRttiMethod read FMethod write SetMethod; + property ThreadMode: TThreadMode read FThreadMode write SetThreadMode; + property Context: String read FContext write SetContext; + function Equals(Obj: TObject): Boolean; override; + end; + + TSubscription = class(TObject) + private + FSubscriberMethod: TSubscriberMethod; + FSubscriber: TObject; + FActive: Boolean; + procedure SetActive(const Value: Boolean); + function GetActive: Boolean; + procedure SetSubscriberMethod(const Value: TSubscriberMethod); + procedure SetSubscriber(const Value: TObject); + function GetContext: String; + public + constructor Create(ASubscriber: TObject; + ASubscriberMethod: TSubscriberMethod); + destructor Destroy; override; + property Active: Boolean read GetActive write SetActive; + property Subscriber: TObject read FSubscriber write SetSubscriber; + property SubscriberMethod: TSubscriberMethod read FSubscriberMethod + write SetSubscriberMethod; + property Context: String read GetContext; + function Equals(Obj: TObject): Boolean; override; + + end; + + TSubscribersFinder = class(TObject) + class function FindSubscriberMethods(ASubscriberClass: TClass; + ARaiseExcIfEmpty: Boolean = false): TArray; + end; + +implementation + +uses + RTTIUtilsU, System.SysUtils, System.TypInfo; + +{ TSubscriberMethod } + +constructor TSubscriberMethod.Create(ARttiMethod: TRttiMethod; + AEventType: TClass; AThreadMode: TThreadMode; const AContext: String = ''; + APriority: Integer = 1); +begin + FMethod := ARttiMethod; + FEventType := AEventType; + FThreadMode := AThreadMode; + FContext := AContext; +end; + +destructor TSubscriberMethod.Destroy; +begin + inherited; +end; + +function TSubscriberMethod.Equals(Obj: TObject): Boolean; +var + OtherSubscriberMethod: TSubscriberMethod; +begin + if (inherited Equals(Obj)) then + exit(true) + else if (Obj is TSubscriberMethod) then + begin + OtherSubscriberMethod := TSubscriberMethod(Obj); + exit(OtherSubscriberMethod.Method.ToString = Method.ToString); + end + else + exit(false); +end; + +procedure TSubscriberMethod.SetContext(const Value: String); +begin + FContext := Value; +end; + +procedure TSubscriberMethod.SetEventType(const Value: TClass); +begin + FEventType := Value; +end; + +procedure TSubscriberMethod.SetMethod(const Value: TRttiMethod); +begin + FMethod := Value; +end; + +procedure TSubscriberMethod.SetThreadMode(const Value: TThreadMode); +begin + FThreadMode := Value; +end; + +{ TSubscribersFinder } + +class function TSubscribersFinder.FindSubscriberMethods(ASubscriberClass + : TClass; ARaiseExcIfEmpty: Boolean = false): TArray; +var + LRttiType: TRttiType; + LSubscribeAttribute: SubscribeAttribute; + LRttiMethods: TArray; + LMethod: TRttiMethod; + LParamsLength: Integer; + LEventType: TClass; + LSubMethod: TSubscriberMethod; +begin + LRttiType := TRTTIUtils.ctx.GetType(ASubscriberClass); + LRttiMethods := LRttiType.GetMethods; + for LMethod in LRttiMethods do + if TRTTIUtils.HasAttribute(LMethod, LSubscribeAttribute) + then + begin + LParamsLength := Length(LMethod.GetParameters); + if (LParamsLength <> 1) then + raise Exception.CreateFmt + ('Method %s has Subscribe attribute but requires %d arguments. Methods must require a single argument.', + [LMethod.Name, LParamsLength]); + LEventType := LMethod.GetParameters[0].ParamType.Handle.TypeData. + ClassType; + LSubMethod := TSubscriberMethod.Create(LMethod, LEventType, + LSubscribeAttribute.ThreadMode, LSubscribeAttribute.Context); +{$IF CompilerVersion >= 28.0} + Result := Result + [LSubMethod]; +{$ELSE} + SetLength(Result, Length(Result) + 1); + Result[High(Result)] := LSubMethod; +{$ENDIF} + end; + //if (Length(Result) < 1) and ARaiseExcIfEmpty then + // raise Exception.CreateFmt + // ('The class %s and its super classes have no public methods with the Subscribe attributes', + // [ASubscriberClass.QualifiedClassName]); +end; + +{ TSubscription } + +constructor TSubscription.Create(ASubscriber: TObject; + ASubscriberMethod: TSubscriberMethod); +begin + inherited Create; + FSubscriber := ASubscriber; + FSubscriberMethod := ASubscriberMethod; + FActive := true; +end; + +destructor TSubscription.Destroy; +begin + if Assigned(FSubscriberMethod) then + FreeAndNil(FSubscriberMethod); + inherited; +end; + +function TSubscription.Equals(Obj: TObject): Boolean; +var + LOtherSubscription: TSubscription; +begin + if (Obj is TSubscription) then + begin + LOtherSubscription := TSubscription(Obj); + exit((Subscriber = LOtherSubscription.Subscriber) and + (SubscriberMethod.Equals(LOtherSubscription.SubscriberMethod))); + end + else + exit(false); +end; + +function TSubscription.GetActive: Boolean; +begin + TMonitor.Enter(self); + try + Result := FActive; + finally + TMonitor.exit(self); + end; +end; + +function TSubscription.GetContext: String; +begin + Result := SubscriberMethod.Context; +end; + +procedure TSubscription.SetActive(const Value: Boolean); +begin + TMonitor.Enter(self); + try + FActive := Value; + finally + TMonitor.exit(self); + end; +end; + +procedure TSubscription.SetSubscriberMethod(const Value: TSubscriberMethod); +begin + FSubscriberMethod := Value; +end; + +procedure TSubscription.SetSubscriber(const Value: TObject); +begin + FSubscriber := Value; +end; + +end. diff --git a/src/ObjectsMappers.pas b/src/ObjectsMappers.pas new file mode 100644 index 0000000..72ff6b2 --- /dev/null +++ b/src/ObjectsMappers.pas @@ -0,0 +1,3033 @@ +{***************************************************************************} +{ } +{ Delphi MVC Framework } +{ } +{ Copyright (c) 2010-2015 Daniele Teti and the DMVCFramework Team } +{ } +{ https://github.com/danieleteti/delphimvcframework } +{ } +{***************************************************************************} +{ } +{ Licensed under the Apache License, Version 2.0 (the "License"); } +{ you may not use this file except in compliance with the License. } +{ You may obtain a copy of the License at } +{ } +{ http://www.apache.org/licenses/LICENSE-2.0 } +{ } +{ Unless required by applicable law or agreed to in writing, software } +{ distributed under the License is distributed on an "AS IS" BASIS, } +{ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } +{ See the License for the specific language governing permissions and } +{ limitations under the License. } +{ } +{***************************************************************************} + +unit ObjectsMappers; + +interface + +uses + System.RTTI, + System.IOUtils, + DBXPLatform, + DB, + Generics.Collections, +{$IF CompilerVersion < 27} + Data.DBXJSON, + Data.SqlExpr, + DBXCommon, +{$ELSE} + System.JSON, +{$ENDIF} +{$IF CompilerVersion > 25} + FireDAC.Comp.Client, FireDAC.Stan.Param, +{$IFEND} + DuckListU, System.SysUtils; + +type + { ***** Daniele Spinetti ***** } + TFieldNamePolicy = (fpLowerCase, fpUpperCase, fpAsIs); + { ***** END - Daniele Spinetti ***** } + + EMapperException = class(Exception) + + end; + + TSerializationType = (Properties, Fields); + + TJSONObjectActionProc = reference to procedure(const AJSONObject: TJSONObject); + + Mapper = class + strict private + class var ctx: TRTTIContext; + + private +{$IF CompilerVersion > 25} + class function InternalExecuteFDQuery(AQuery: TFDQuery; AObject: TObject; + WithResult: boolean): Int64; +{$ELSE} + class function InternalExecuteSQLQuery(AQuery: TSQLQuery; AObject: TObject; + WithResult: boolean): Int64; +{$IFEND} + class function GetKeyName(const ARttiField: TRttiField; AType: TRttiType): string; overload; + class function GetKeyName(const ARttiProp: TRttiProperty; AType: TRttiType): string; overload; + class procedure InternalJSONObjectToObject(ctx: TRTTIContext; AJSONObject: TJSONObject; + AObject: TObject); static; + class procedure InternalJSONObjectFieldsToObject(ctx: TRTTIContext; AJSONObject: TJSONObject; + AObject: TObject); static; + + { following methods are used by the serializer/unserializer to handle with the ser/unser logic } + class function SerializeFloatProperty(AObject: TObject; ARTTIProperty: TRttiProperty) + : TJSONValue; + class function SerializeFloatField(AObject: TObject; ARttiField: TRttiField): TJSONValue; + class function SerializeEnumerationProperty(AObject: TObject; ARTTIProperty: TRttiProperty) + : TJSONValue; + class function SerializeEnumerationField(AObject: TObject; ARttiField: TRttiField): TJSONValue; + public + class function HasAttribute(ARTTIMember: TRttiNamedObject): boolean; overload; + class function HasAttribute(ARTTIMember: TRttiNamedObject; out AAttribute: T) + : boolean; overload; + + /// + /// Do not restore nested classes + /// + class function JSONObjectToObject(AJSONObject: TJSONObject): T; + overload; static; + class function JSONObjectStringToObject(const AJSONObjectString + : string): T; + + class function JSONObjectToObject(Clazz: TClass; AJSONObject: TJSONObject): TObject; + overload; static; + class function JSONObjectToObject(ClazzName: string; AJSONObject: TJSONObject): TObject; + overload; static; + class function JSONObjectToObjectFields(AJSONObject: TJSONObject) + : T; static; + class procedure ObjectToDataSet(Obj: TObject; Field: TField; var Value: Variant); static; + class procedure DataSetToObject(ADataSet: TDataSet; AObject: TObject); + class function ObjectToJSONObject(AObject: TObject; AIgnoredProperties: array of string) + : TJSONObject; overload; + ///

    + /// Serializes an object to a jsonobject using fields value, not property values. WARNING! This + /// method do not generate the $dmvc_classname property in the jsonobject. To have the $dmvc_classname + /// into the json you should use ObjectToJSONObjectFields. + /// + class function ObjectToJSONObjectFields(AObject: TObject; AIgnoredProperties: array of string) + : TJSONObject; overload; + class function ObjectToJSONObjectFieldsString(AObject: TObject; + AIgnoredProperties: array of string): string; overload; + + /// + /// Restore the object stored in the JSON object using the $dmvc_classname property + /// to know the qualified full class name. Values readed from the json are restored directly to the object fields. + /// Fields MUST be exists into the json. This kind of deserialization is way more strit than the properties based. + /// It should not be used to serialize object for a thin client, but to serialize objects that must be deserialized using + /// the same delphi class. So this method is useful when you are developing a delphi-delphi solution. Exceptions apply. + /// + class function JSONObjectFieldsToObject(AJSONObject: TJSONObject): TObject; + /// + /// Serialize an object to a JSONObject using properties values. It is useful when you + /// have to send derived or calculated properties. It is not a simple serialization, it bring + /// also all the logic applyed to the oebjsct properties (es. Price,Q.ty, Discount, Total. Total is + /// a derived property) + /// + class function ObjectToJSONObject(AObject: TObject): TJSONObject; overload; + /// + /// Identical to ObjectToJSONObject but it return a string representation instead of a json object + /// + class function ObjectToJSONObjectString(AObject: TObject): string; + class function ObjectToJSONArray(AObject: TObject): TJSONArray; + { ***** Daniele Spinetti ***** } + class function JSONArrayToObjectList(AListOf: TClass; AJSONArray: TJSONArray; + AInstanceOwner: boolean = True; AOwnsChildObjects: boolean = True) + : TObjectList; overload; + { ***** Daniele Spinetti ***** } + class procedure JSONArrayToObjectList(AList: IWrappedList; AListOf: TClass; + AJSONArray: TJSONArray; AInstanceOwner: boolean = True; + AOwnsChildObjects: boolean = True); overload; + class function JSONArrayToObjectList(AJSONArray: TJSONArray; + AInstanceOwner: boolean = True; AOwnsChildObjects: boolean = True): TObjectList; overload; + class procedure JSONArrayToObjectList(AList: TObjectList; + AJSONArray: TJSONArray; AInstanceOwner: boolean = True; + AOwnsChildObjects: boolean = True); overload; +{$IF CompilerVersion <= 25} + class procedure ReaderToObject(AReader: TDBXReader; AObject: TObject); + class procedure ReaderToObjectList(AReader: TDBXReader; + AObjectList: TObjectList); + class procedure ReaderToJSONObject(AReader: TDBXReader; AJSONObject: TJSONObject; + AReaderInstanceOwner: boolean = True); +{$ENDIF} + class procedure DataSetToJSONObject(ADataSet: TDataSet; AJSONObject: TJSONObject; + ADataSetInstanceOwner: boolean = True; AJSONObjectActionProc: TJSONObjectActionProc = nil; + AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); + class procedure JSONObjectToDataSet(AJSONObject: TJSONObject; ADataSet: TDataSet; + AJSONObjectInstanceOwner: boolean = True); overload; + class procedure JSONObjectToDataSet(AJSONObject: TJSONObject; ADataSet: TDataSet; + AIgnoredFields: TArray; AJSONObjectInstanceOwner: boolean = True; + AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload; + class procedure DataSetToObjectList(ADataSet: TDataSet; + AObjectList: TObjectList; ACloseDataSetAfterScroll: boolean = True); + class function DataSetToJSONArrayOf(ADataSet: TDataSet): TJSONArray; +{$IF CompilerVersion <= 25} + class procedure ReaderToList(AReader: TDBXReader; AList: IWrappedList); + class procedure ReaderToJSONArray(AReader: TDBXReader; AJSONArray: TJSONArray; + AReaderInstanceOwner: boolean = True); +{$ENDIF} + class procedure DataSetToJSONArray(ADataSet: TDataSet; AJSONArray: TJSONArray; + ADataSetInstanceOwner: boolean = True; AJSONObjectActionProc: TJSONObjectActionProc = nil); + class procedure JSONArrayToDataSet(AJSONArray: TJSONArray; ADataSet: TDataSet; + AJSONArrayInstanceOwner: boolean = True); overload; + class procedure JSONArrayToDataSet(AJSONArray: TJSONArray; ADataSet: TDataSet; + AIgnoredFields: TArray; AJSONArrayInstanceOwner: boolean = True; + AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload; + // class procedure DataSetRowToXML(ADataSet: TDataSet; Row: IXMLNode; + // ADataSetInstanceOwner: boolean = True); + // class procedure DataSetToXML(ADataSet: TDataSet; XMLDocument: String; + // ADataSetInstanceOwner: boolean = True); + class function ObjectListToJSONArray(AList: TObjectList; + AOwnsInstance: boolean = false; AForEach: TJSONObjectActionProc = nil): TJSONArray; overload; + class function ObjectListToJSONArray(AList: IWrappedList; + AOwnsChildObjects: boolean = true; AForEach: TJSONObjectActionProc = nil): TJSONArray; overload; + class function ObjectListToJSONArrayFields(AList: TObjectList; + AOwnsInstance: boolean = false; AForEach: TJSONObjectActionProc = nil): TJSONArray; + class function ObjectListToJSONArrayString(AList: TObjectList; + AOwnsInstance: boolean = false): string; overload; + class function ObjectListToJSONArrayString(AList: IWrappedList; + AOwnsChildObjects: boolean = true): string; overload; + class function ObjectListToJSONArrayOfJSONArray(AList: TObjectList) + : TJSONArray; + class function GetProperty(Obj: TObject; const PropertyName: string): TValue; static; +{$IF CompilerVersion <= 25} + class function ExecuteSQLQueryNoResult(AQuery: TSQLQuery; AObject: TObject): Int64; + class procedure ExecuteSQLQuery(AQuery: TSQLQuery; AObject: TObject = nil); + class function ExecuteSQLQueryAsObjectList(AQuery: TSQLQuery; + AObject: TObject = nil): TObjectList; + class function CreateQuery(AConnection: TSQLConnection; ASQL: string): TSQLQuery; +{$ENDIF} + { FIREDAC RELATED METHODS } +{$IF CompilerVersion > 25} + class function ExecuteFDQueryNoResult(AQuery: TFDQuery; AObject: TObject): Int64; + class procedure ExecuteFDQuery(AQuery: TFDQuery; AObject: TObject); + class procedure ObjectToFDParameters(AFDParams: TFDParams; AObject: TObject; + AParamPrefix: string = ''); +{$IFEND} + // SAFE TJSONObject getter + class function GetPair(JSONObject: TJSONObject; PropertyName: string): TJSONPair; + class function GetStringDef(JSONObject: TJSONObject; PropertyName: string; + DefaultValue: string = ''): string; + class function GetNumberDef(JSONObject: TJSONObject; PropertyName: string; + DefaultValue: Extended = 0): Extended; + class function GetJSONObj(JSONObject: TJSONObject; PropertyName: string): TJSONObject; + class function GetJSONArray(JSONObject: TJSONObject; PropertyName: string): TJSONArray; + class function GetIntegerDef(JSONObject: TJSONObject; PropertyName: string; + DefaultValue: Integer = 0): Integer; + class function GetInt64Def(JSONObject: TJSONObject; PropertyName: string; + DefaultValue: Int64 = 0): Int64; + class function GetBooleanDef(JSONObject: TJSONObject; PropertyName: string; + DefaultValue: boolean = false): boolean; + class function PropertyExists(JSONObject: TJSONObject; PropertyName: string): boolean; + end; + + TDataSetHelper = class helper for TDataSet + public + function AsJSONArray: TJSONArray; + function AsJSONArrayString: string; + function AsJSONObject(AReturnNilIfEOF: boolean = false; + AFieldNamePolicy: TFieldNamePolicy = fpLowerCase): TJSONObject; + function AsJSONObjectString(AReturnEmptyStringIfEOF: boolean = false): string; + procedure LoadFromJSONObject(AJSONObject: TJSONObject; + AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload; + procedure LoadFromJSONObject(AJSONObject: TJSONObject; AIgnoredFields: TArray; + AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload; + procedure LoadFromJSONArray(AJSONArray: TJSONArray; + AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload; + procedure LoadFromJSONArrayString(AJSONArrayString: string); + procedure LoadFromJSONArray(AJSONArray: TJSONArray; AIgnoredFields: TArray); overload; + procedure LoadFromJSONObjectString(AJSONObjectString: string); overload; + procedure LoadFromJSONObjectString(AJSONObjectString: string; + AIgnoredFields: TArray); overload; + procedure AppendFromJSONArrayString(AJSONArrayString: string); overload; + procedure AppendFromJSONArrayString(AJSONArrayString: string; + AIgnoredFields: TArray); overload; + function AsObjectList(CloseAfterScroll: boolean = false): TObjectList; + function AsObject(CloseAfterScroll: boolean = false): T; + end; + + MapperTransientAttribute = class(TCustomAttribute) + + end; + + DoNotSerializeAttribute = class(TCustomAttribute) + + end; + + MapperItemsClassType = class(TCustomAttribute) + private + FValue: TClass; + procedure SetValue(const Value: TClass); + + public + constructor Create(Value: TClass); + property Value: TClass read FValue write SetValue; + end; + + MapperListOf = MapperItemsClassType; // just to be more similar to DORM + + TJSONNameCase = (JSONNameUpperCase, JSONNameLowerCase); + + HideInGrids = class(TCustomAttribute) + + end; + + StringValueAttribute = class abstract(TCustomAttribute) + private + FValue: string; + procedure SetValue(const Value: string); + + public + constructor Create(Value: string); + property Value: string read FValue write SetValue; + end; + + FormatFloatValue = class(StringValueAttribute) + + end; + + FormatDateTimeValue = class(StringValueAttribute) + + end; + + MapperSerializeAsString = class(TCustomAttribute) + strict private + FEncoding: string; + procedure SetEncoding(const Value: string); + + const + DefaultEncoding = 'utf-8'; + public + constructor Create(AEncoding: string = DefaultEncoding); + property Encoding: string read FEncoding write SetEncoding; + end; + + MapperJSONNaming = class(TCustomAttribute) + private + FJSONKeyCase: TJSONNameCase; + function GetKeyCase: TJSONNameCase; + + public + constructor Create(JSONKeyCase: TJSONNameCase); + property KeyCase: TJSONNameCase read GetKeyCase; + end; + + MapperJSONSer = class(TCustomAttribute) + private + FName: string; + function GetName: string; + + public + constructor Create(AName: string); + property name: string read GetName; + end; + + MapperColumnAttribute = class(TCustomAttribute) + private + FFieldName: string; + FIsPK: boolean; + procedure SetFieldName(const Value: string); + procedure SetIsPK(const Value: boolean); + + public + constructor Create(AFieldName: string; AIsPK: boolean = false); + property FieldName: string read FFieldName write SetFieldName; + property IsPK: boolean read FIsPK write SetIsPK; + end; + + TGridColumnAlign = (caLeft, caCenter, caRight); + + GridColumnProps = class(TCustomAttribute) + private + FCaption: string; + FAlign: TGridColumnAlign; + FWidth: Integer; + function GetAlignAsString: string; + + public + constructor Create(ACaption: string; AAlign: TGridColumnAlign = caCenter; + AWidth: Integer = -1); + property Caption: string read FCaption; + property Align: TGridColumnAlign read FAlign; + property AlignAsString: string read GetAlignAsString; + property Width: Integer read FWidth; + end; + +function ISODateTimeToString(ADateTime: TDateTime): string; +function ISODateToString(ADate: TDateTime): string; +function ISOTimeToString(ATime: TTime): string; + +function ISOStrToDateTime(DateTimeAsString: string): TDateTime; +function ISOStrToDate(DateAsString: string): TDate; +function ISOStrToTime(TimeAsString: string): TTime; + + +// function ISODateToStr(const ADate: TDate): String; +// +// function ISOTimeToStr(const ATime: TTime): String; + +implementation + +{$WARN SYMBOL_DEPRECATED OFF} + + +uses + TypInfo, + FmtBcd, + Math, + SqlTimSt, + DateUtils, + Classes, + RTTIUtilsU, + Xml.adomxmldom, +{$IF CompilerVersion >= 28} + System.NetEncoding, // so that the old functions in Soap.EncdDecd can be inlined +{$ENDIF} + Soap.EncdDecd; + +const + DMVC_CLASSNAME = '$dmvc_classname'; + { Mapper } + +function ContainsFieldName(const FieldName: string; var FieldsArray: TArray): boolean; +var + I: Integer; +begin + for I := 0 to Length(FieldsArray) - 1 do + begin + if SameText(FieldsArray[I], FieldName) then + Exit(True); + end; + Result := false; +end; + +function ISOTimeToString(ATime: TTime): string; +var + fs: TFormatSettings; +begin + fs.TimeSeparator := ':'; + Result := FormatDateTime('hh:nn:ss', ATime, fs); +end; + +function ISODateToString(ADate: TDateTime): string; +begin + Result := FormatDateTime('YYYY-MM-DD', ADate); +end; + +function ISODateTimeToString(ADateTime: TDateTime): string; +var + fs: TFormatSettings; +begin + fs.TimeSeparator := ':'; + Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', ADateTime, fs); +end; + +function ISOStrToDateTime(DateTimeAsString: string): TDateTime; +begin + Result := EncodeDateTime(StrToInt(Copy(DateTimeAsString, 1, 4)), + StrToInt(Copy(DateTimeAsString, 6, 2)), StrToInt(Copy(DateTimeAsString, 9, 2)), + StrToInt(Copy(DateTimeAsString, 12, 2)), StrToInt(Copy(DateTimeAsString, 15, 2)), + StrToInt(Copy(DateTimeAsString, 18, 2)), 0); +end; + +function ISOStrToTime(TimeAsString: string): TTime; +begin + Result := EncodeTime(StrToInt(Copy(TimeAsString, 1, 2)), StrToInt(Copy(TimeAsString, 4, 2)), + StrToInt(Copy(TimeAsString, 7, 2)), 0); +end; + +function ISOStrToDate(DateAsString: string): TDate; +begin + Result := EncodeDate(StrToInt(Copy(DateAsString, 1, 4)), StrToInt(Copy(DateAsString, 6, 2)), + StrToInt(Copy(DateAsString, 9, 2))); + // , StrToInt + // (Copy(DateAsString, 12, 2)), StrToInt(Copy(DateAsString, 15, 2)), + // StrToInt(Copy(DateAsString, 18, 2)), 0); +end; + + +// function ISODateToStr(const ADate: TDate): String; +// begin +// Result := FormatDateTime('YYYY-MM-DD', ADate); +// end; +// +// function ISOTimeToStr(const ATime: TTime): String; +// begin +// Result := FormatDateTime('HH:nn:ss', ATime); +// end; + +{$IF CompilerVersion <= 25} + + +class function Mapper.InternalExecuteSQLQuery(AQuery: TSQLQuery; AObject: TObject; + WithResult: boolean): Int64; +var + I: Integer; + pname: string; + _rttiType: TRttiType; + obj_fields: TArray; + obj_field: TRttiProperty; + obj_field_attr: MapperColumnAttribute; + Map: TObjectDictionary; + f: TRttiProperty; + fv: TValue; +begin + Map := TObjectDictionary.Create; + try + if Assigned(AObject) then + begin + _rttiType := ctx.GetType(AObject.ClassType); + obj_fields := _rttiType.GetProperties; + for obj_field in obj_fields do + begin + if HasAttribute(obj_field, obj_field_attr) then + begin + Map.Add(MapperColumnAttribute(obj_field_attr).FieldName, obj_field); + end + else + begin + Map.Add(LowerCase(obj_field.Name), obj_field); + end + end; + end; + for I := 0 to AQuery.Params.Count - 1 do + begin + pname := AQuery.Params[I].Name; + if Map.TryGetValue(pname, f) then + begin + fv := f.GetValue(AObject); + AQuery.Params[I].Value := fv.AsVariant; + end + else + begin + AQuery.Params[I].Clear; + AQuery.Params[I].DataType := ftString; // just to make dbx happy + + end; + end; + Result := 0; + if WithResult then + AQuery.Open + else + Result := AQuery.ExecSQL; + finally + Map.Free; + end; +end; + +class procedure Mapper.ReaderToJSONArray(AReader: TDBXReader; AJSONArray: TJSONArray; + AReaderInstanceOwner: boolean); +var + Obj: TJSONObject; +begin + while AReader.Next do + begin + Obj := TJSONObject.Create; + AJSONArray.AddElement(Obj); + ReaderToJSONObject(AReader, Obj, false); + end; + if AReaderInstanceOwner then + FreeAndNil(AReader); +end; + +class procedure Mapper.ReaderToJSONObject(AReader: TDBXReader; AJSONObject: TJSONObject; + AReaderInstanceOwner: boolean); +var + I: Integer; + key: string; + dt: TDateTime; + Time: TTimeStamp; + ts: TSQLTimeStamp; +begin + for I := 0 to AReader.ColumnCount - 1 do + begin + key := LowerCase(AReader.Value[I].ValueType.Name); + case AReader.Value[I].ValueType.DataType of + TDBXDataTypes.Int16Type: + AJSONObject.AddPair(key, TJSONNumber.Create(AReader.Value[I].AsInt16)); + TDBXDataTypes.Int32Type: + AJSONObject.AddPair(key, TJSONNumber.Create(AReader.Value[I].AsInt32)); + TDBXDataTypes.Int64Type: + AJSONObject.AddPair(key, TJSONNumber.Create(AReader.Value[I].AsInt64)); + TDBXDataTypes.DoubleType: + AJSONObject.AddPair(key, TJSONNumber.Create(AReader.Value[I].AsDouble)); + TDBXDataTypes.AnsiStringType, TDBXDataTypes.WideStringType: + AJSONObject.AddPair(key, AReader.Value[I].AsString); + TDBXDataTypes.BcdType: + AJSONObject.AddPair(key, TJSONNumber.Create(BcdToDouble(AReader.Value[I].AsBcd))); + TDBXDataTypes.DateType: + begin + if not AReader.Value[I].IsNull then + begin + Time.Time := 0; + Time.date := AReader.Value[I].AsDate; + dt := TimeStampToDateTime(Time); + AJSONObject.AddPair(key, ISODateToString(dt)); + end + else + AJSONObject.AddPair(key, TJSONNull.Create); + end; + TDBXDataTypes.TimeType: + begin + if not AReader.Value[I].IsNull then + begin + ts := AReader.Value[I].AsTimeStamp; + AJSONObject.AddPair(key, SQLTimeStampToStr('hh:nn:ss', ts)); + end + else + AJSONObject.AddPair(key, TJSONNull.Create); + end + else + raise EMapperException.Create('Cannot find type'); + end; + end; + if AReaderInstanceOwner then + FreeAndNil(AReader); +end; + +class procedure Mapper.ReaderToList(AReader: TDBXReader; AList: IWrappedList); +var + Obj: T; +begin + while AReader.Next do + begin + Obj := T.Create; + ReaderToObject(AReader, Obj); + AList.Add(Obj); + end; + AReader.Close; +end; + +class procedure Mapper.ReaderToObject(AReader: TDBXReader; AObject: TObject); +var + _type: TRttiType; + _fields: TArray; + _field: TRttiProperty; + _attribute: MapperColumnAttribute; + _dict: TDictionary; + _keys: TDictionary; + mf: MapperColumnAttribute; + field_name: string; + Value: TValue; + ts: TTimeStamp; + sqlts: TSQLTimeStamp; +begin + _dict := TDictionary.Create(); + _keys := TDictionary.Create(); + _type := ctx.GetType(AObject.ClassInfo); + _fields := _type.GetProperties; + for _field in _fields do + if HasAttribute(_field, _attribute) then + begin + mf := _attribute; + _dict.Add(_field.Name, mf.FieldName); + _keys.Add(_field.Name, mf.IsPK); + end + else + begin + _dict.Add(_field.Name, _field.Name); + _keys.Add(_field.Name, false); + end; + + for _field in _fields do + begin + if (not _dict.TryGetValue(_field.Name, field_name)) or (not _field.IsWritable) or + (HasAttribute(_field)) then + Continue; + case _field.PropertyType.TypeKind of + tkInteger: + Value := AReader.Value[field_name].AsInt32; + tkFloat: + begin + if AReader.Value[field_name].IsNull then + Value := 0 + else + begin + if AReader.Value[field_name].ValueType.DataType = TDBXDataTypes.DateType then + begin + ts.Time := 0; + ts.date := AReader.Value[field_name].AsDate; + Value := TimeStampToDateTime(ts); + end + else if AReader.Value[field_name].ValueType.DataType = TDBXDataTypes.DoubleType then + Value := AReader.Value[field_name].AsDouble + else if AReader.Value[field_name].ValueType.DataType = TDBXDataTypes.BcdType then + Value := BcdToDouble(AReader.Value[field_name].AsBcd) + else if AReader.Value[field_name].ValueType.DataType = TDBXDataTypes.TimeType then + begin + sqlts := AReader.Value[field_name].AsTimeStamp; + Value := SQLTimeStampToDateTime(sqlts); + end + else + raise EMapperException.Create('Unknown tkFloat Type'); + end; + end; + tkString, tkUString, tkWChar, tkLString, tkWString: + begin + if AReader.Value[field_name].IsNull then + Value := '' + else + Value := AReader.Value[field_name].AsString; + end; + else + raise EMapperException.Create('Unknown field type for ' + field_name); + end; + _field.SetValue(AObject, Value); + end; + _dict.Free; + _keys.Free; +end; + +class procedure Mapper.ReaderToObjectList(AReader: TDBXReader; AObjectList: TObjectList); +var + Obj: T; +begin + while AReader.Next do + begin + Obj := T.Create; + ReaderToObject(AReader, Obj); + AObjectList.Add(Obj); + end; + AReader.Close; +end; + +class function Mapper.CreateQuery(AConnection: TSQLConnection; ASQL: string): TSQLQuery; +begin + Result := TSQLQuery.Create(nil); + Result.SQLConnection := AConnection; + Result.CommandText := ASQL; +end; +{$IFEND} + + +class procedure Mapper.DataSetToJSONArray(ADataSet: TDataSet; AJSONArray: TJSONArray; + ADataSetInstanceOwner: boolean; AJSONObjectActionProc: TJSONObjectActionProc); +var + Obj: TJSONObject; +begin + while not ADataSet.Eof do + begin + Obj := TJSONObject.Create; + AJSONArray.AddElement(Obj); + DataSetToJSONObject(ADataSet, Obj, false, AJSONObjectActionProc); + ADataSet.Next; + end; + // repeat + // Obj := TJSONObject.Create; + // AJSONArray.AddElement(Obj); + // DataSetToJSONObject(ADataSet, Obj, false); + // ADataSet.Next; + // until ADataSet.Eof; + + if ADataSetInstanceOwner then + FreeAndNil(ADataSet); +end; + +class function Mapper.DataSetToJSONArrayOf(ADataSet: TDataSet): TJSONArray; +var + list: TObjectList; +begin + list := TObjectList.Create; + try + Mapper.DataSetToObjectList(ADataSet, list); + Result := Mapper.ObjectListToJSONArray(list); + finally + list.Free; + end; +end; + +class procedure Mapper.DataSetToJSONObject(ADataSet: TDataSet; AJSONObject: TJSONObject; + ADataSetInstanceOwner: boolean; AJSONObjectActionProc: TJSONObjectActionProc; + AFieldNamePolicy: TFieldNamePolicy); +var + I: Integer; + key: string; + ts: TSQLTimeStamp; + MS: TMemoryStream; + SS: TStringStream; +begin + for I := 0 to ADataSet.FieldCount - 1 do + begin + // Name policy { ***** Daniele Spinetti ***** } + case AFieldNamePolicy of + fpLowerCase: + key := LowerCase(ADataSet.Fields[I].FieldName); + fpUpperCase: + key := UpperCase(ADataSet.Fields[I].FieldName); + fpAsIs: + key := ADataSet.Fields[I].FieldName; + end; + + if ADataSet.Fields[I].IsNull then + begin + AJSONObject.AddPair(key, TJSONNull.Create); + Continue; + end; + case ADataSet.Fields[I].DataType of + TFieldType.ftInteger, TFieldType.ftAutoInc, TFieldType.ftSmallint, TFieldType.ftShortint: + AJSONObject.AddPair(key, TJSONNumber.Create(ADataSet.Fields[I].AsInteger)); + TFieldType.ftLargeint: + begin + AJSONObject.AddPair(key, TJSONNumber.Create(ADataSet.Fields[I].AsLargeInt)); + end; + TFieldType.ftSingle, TFieldType.ftFloat: + AJSONObject.AddPair(key, TJSONNumber.Create(ADataSet.Fields[I].AsFloat)); + ftWideString, ftMemo, ftWideMemo: + AJSONObject.AddPair(key, ADataSet.Fields[I].AsWideString); + ftString: + AJSONObject.AddPair(key, ADataSet.Fields[I].AsString); + TFieldType.ftDate: + begin + AJSONObject.AddPair(key, ISODateToString(ADataSet.Fields[I].AsDateTime)); + end; + TFieldType.ftDateTime: + begin + AJSONObject.AddPair(key, ISODateTimeToString(ADataSet.Fields[I].AsDateTime)); + end; + TFieldType.ftTimeStamp: + begin + ts := ADataSet.Fields[I].AsSQLTimeStamp; + AJSONObject.AddPair(key, SQLTimeStampToStr('yyyy-mm-dd hh:nn:ss', ts)); + end; + TFieldType.ftCurrency: + begin + // AJSONObject.AddPair(key, FormatCurr('0.00##', ADataSet.Fields[I].AsCurrency)); + AJSONObject.AddPair(key, TJSONNumber.Create(ADataSet.Fields[I].AsCurrency)); + end; + TFieldType.ftBCD, TFieldType.ftFMTBcd: + begin + AJSONObject.AddPair(key, TJSONNumber.Create(BcdToDouble(ADataSet.Fields[I].AsBcd))); + end; + TFieldType.ftGraphic, TFieldType.ftBlob, TFieldType.ftStream: + begin + MS := TMemoryStream.Create; + try + TBlobField(ADataSet.Fields[I]).SaveToStream(MS); + MS.Position := 0; + SS := TStringStream.Create('', TEncoding.ASCII); + try + EncodeStream(MS, SS); + SS.Position := 0; + AJSONObject.AddPair(key, SS.DataString); + finally + SS.Free; + end; + finally + MS.Free; + end; + end; + + // else + // raise EMapperException.Create('Cannot find type for field ' + key); + end; + end; + if ADataSetInstanceOwner then + FreeAndNil(ADataSet); + if Assigned(AJSONObjectActionProc) then + AJSONObjectActionProc(AJSONObject); +end; + +class procedure Mapper.DataSetToObject(ADataSet: TDataSet; AObject: TObject); +var + _type: TRttiType; + _fields: TArray; + _field: TRttiProperty; + _attribute: TCustomAttribute; + _dict: TDictionary; + _keys: TDictionary; + mf: MapperColumnAttribute; + field_name: string; + Value: TValue; + FoundAttribute: boolean; + FoundTransientAttribute: boolean; +begin + _dict := TDictionary.Create(); + _keys := TDictionary.Create(); + _type := ctx.GetType(AObject.ClassInfo); + _fields := _type.GetProperties; + for _field in _fields do + begin + FoundAttribute := false; + FoundTransientAttribute := false; + for _attribute in _field.GetAttributes do + begin + if _attribute is MapperColumnAttribute then + begin + FoundAttribute := True; + mf := MapperColumnAttribute(_attribute); + _dict.Add(_field.Name, mf.FieldName); + _keys.Add(_field.Name, mf.IsPK); + end + else if _attribute is MapperTransientAttribute then + FoundTransientAttribute := True; + end; + if ((not FoundAttribute) and (not FoundTransientAttribute)) then + begin + _dict.Add(_field.Name, _field.Name); + _keys.Add(_field.Name, false); + end; + end; + for _field in _fields do + begin + if not _dict.TryGetValue(_field.Name, field_name) then + Continue; + case _field.PropertyType.TypeKind of + tkEnumeration : // tristan + begin + if _field.PropertyType.Handle = TypeInfo(Boolean) then + begin + case ADataSet.FieldByName(field_name).DataType of + ftInteger, ftSmallint, ftLargeint : + begin + Value := (ADataSet.FieldByName(field_name).AsInteger = 1); + end; + ftBoolean : + begin + Value := ADataSet.FieldByName(field_name).AsBoolean; + end; + else + Continue; + end; + end; + end; + tkInteger: + Value := ADataSet.FieldByName(field_name).AsInteger; + tkInt64: + Value := ADataSet.FieldByName(field_name).AsLargeInt; + tkFloat: + Value := ADataSet.FieldByName(field_name).AsFloat; + tkString: + Value := ADataSet.FieldByName(field_name).AsString; + tkUString, tkWChar, tkLString, tkWString: + Value := ADataSet.FieldByName(field_name).AsWideString; + else + Continue; + end; + _field.SetValue(AObject, Value); + end; + _dict.Free; + _keys.Free; +end; + +class function Mapper.ObjectListToJSONArrayFields(AList: TObjectList; + AOwnsInstance: boolean = false; AForEach: TJSONObjectActionProc = nil): TJSONArray; +var + I: Integer; + JV: TJSONObject; +begin + Result := TJSONArray.Create; + if Assigned(AList) then + for I := 0 to AList.Count - 1 do + begin + JV := ObjectToJSONObjectFields(AList[I], []); + if Assigned(AForEach) then + AForEach(JV); + Result.AddElement(JV); + end; + if AOwnsInstance then + AList.Free; +end; + +class function Mapper.ObjectListToJSONArray(AList: TObjectList; AOwnsInstance: boolean; + AForEach: TJSONObjectActionProc): TJSONArray; +var + I: Integer; + JV: TJSONObject; +begin + Result := TJSONArray.Create; + if Assigned(AList) then + for I := 0 to AList.Count - 1 do + begin + JV := ObjectToJSONObject(AList[I]); + if Assigned(AForEach) then + AForEach(JV); + Result.AddElement(JV); + end; + if AOwnsInstance then + AList.Free; +end; + +class function Mapper.ObjectListToJSONArray(AList: IWrappedList; AOwnsChildObjects: boolean; + AForEach: TJSONObjectActionProc): TJSONArray; +var + I: Integer; + JV: TJSONObject; +begin + Result := TJSONArray.Create; + if Assigned(AList) then + begin + AList.OwnsObjects := AOwnsChildObjects; + for I := 0 to AList.Count - 1 do + begin + JV := ObjectToJSONObject(AList.GetItem(I)); + if Assigned(AForEach) then + AForEach(JV); + Result.AddElement(JV); + end; + end; +end; + +class function Mapper.ObjectListToJSONArrayOfJSONArray(AList: TObjectList): TJSONArray; +var + I: Integer; +begin + Result := TJSONArray.Create; + for I := 0 to AList.Count - 1 do + Result.AddElement(ObjectToJSONArray(AList[I])); +end; + +class function Mapper.ObjectListToJSONArrayString(AList: TObjectList; + AOwnsInstance: boolean): string; +var + Arr: TJSONArray; +begin + Arr := Mapper.ObjectListToJSONArray(AList, AOwnsInstance); + try + Result := Arr.ToString; + finally + Arr.Free; + end; +end; + +class function Mapper.ObjectListToJSONArrayString(AList: IWrappedList; + AOwnsChildObjects: boolean): string; +var + Arr: TJSONArray; +begin + Arr := Mapper.ObjectListToJSONArray(AList, AOwnsChildObjects); + try + Result := Arr.ToString; + finally + Arr.Free; + end; +end; + +class procedure Mapper.ObjectToDataSet(Obj: TObject; Field: TField; var Value: Variant); +begin + Value := GetProperty(Obj, Field.FieldName).AsVariant; +end; + +class function Mapper.ObjectToJSONArray(AObject: TObject): TJSONArray; +var + LRTTIType: TRttiType; + LProperties: TArray; + LProperty: TRttiProperty; + LKeyName: string; + LJArray: TJSONArray; + LObj: TObject; + LList: IWrappedList; + LJArr: TJSONArray; + LObjItem: TObject; +begin + LJArray := TJSONArray.Create; + LRTTIType := ctx.GetType(AObject.ClassInfo); + LProperties := LRTTIType.GetProperties; + for LProperty in LProperties do + begin + if HasAttribute(LProperty) then + Continue; + LKeyName := GetKeyName(LProperty, LRTTIType); + case LProperty.PropertyType.TypeKind of + tkEnumeration: + begin + LJArray.AddElement(SerializeEnumerationProperty(AObject, LProperty)); + // if LProperty.PropertyType.QualifiedName = 'System.Boolean' then + // begin + // if LProperty.GetValue(AObject).AsBoolean then + // LJArray.AddElement(TJSONTrue.Create) + // else + // LJArray.AddElement(TJSONFalse.Create) + // end; + end; + tkInteger, tkInt64: + LJArray.AddElement(TJSONNumber.Create(LProperty.GetValue(AObject).AsInteger)); + tkFloat: + begin + LJArray.AddElement(SerializeFloatProperty(AObject, LProperty)); + end; + tkString, tkLString, tkWString, tkUString: + LJArray.AddElement(TJSONString.Create(LProperty.GetValue(AObject).AsString)); + tkClass: + begin + LObj := LProperty.GetValue(AObject).AsObject; + if Assigned(LObj) then + begin + LList := nil; + if TDuckTypedList.CanBeWrappedAsList(LObj) then + LList := WrapAsList(LObj); + if Assigned(LList) then + begin + LJArr := TJSONArray.Create; + LJArray.AddElement(LJArr); + for LObjItem in LList do + begin + LJArr.AddElement(ObjectToJSONObject(LObjItem)); + end; + end + else + begin + LJArray.AddElement(ObjectToJSONObject(LProperty.GetValue(AObject).AsObject)); + end; + end + else + LJArray.AddElement(TJSONNull.Create); + end; + end; + end; + Result := LJArray; +end; + +class function Mapper.ObjectToJSONObject(AObject: TObject; AIgnoredProperties: array of string) + : TJSONObject; +var + _type: TRttiType; + _properties: TArray; + _property: TRttiProperty; + f: string; + JSONObject: TJSONObject; + Arr: TJSONArray; + list: IWrappedList; + Obj, o: TObject; + DoNotSerializeThis: boolean; + I: Integer; + ThereAreIgnoredProperties: boolean; + ts: TTimeStamp; + sr: TStringStream; + SS: TStringStream; + _attrser: MapperSerializeAsString; + SerEnc: TEncoding; + attr: MapperItemsClassType; + ListCount: Integer; + ListItems: TRttiMethod; + ListItemValue: TValue; +begin + ThereAreIgnoredProperties := Length(AIgnoredProperties) > 0; + JSONObject := TJSONObject.Create; + _type := ctx.GetType(AObject.ClassInfo); + _properties := _type.GetProperties; + for _property in _properties do + begin + // f := LowerCase(_property.Name); + f := GetKeyName(_property, _type); + // Delete(f, 1, 1); + if ThereAreIgnoredProperties then + begin + DoNotSerializeThis := false; + for I := low(AIgnoredProperties) to high(AIgnoredProperties) do + if SameText(f, AIgnoredProperties[I]) then + begin + DoNotSerializeThis := True; + Break; + end; + if DoNotSerializeThis then + Continue; + end; + + if HasAttribute(_property) then + Continue; + + case _property.PropertyType.TypeKind of + tkInteger, tkInt64: + JSONObject.AddPair(f, TJSONNumber.Create(_property.GetValue(AObject).AsInteger)); + tkFloat: + begin + JSONObject.AddPair(f, SerializeFloatProperty(AObject, _property)); + { + if _property.PropertyType.QualifiedName = 'System.TDate' then + begin + if _property.GetValue(AObject).AsExtended = 0 then + JSONObject.AddPair(f, TJSONNull.Create) + else + JSONObject.AddPair(f, ISODateToString(_property.GetValue(AObject).AsExtended)) + end + else if _property.PropertyType.QualifiedName = 'System.TDateTime' then + begin + if _property.GetValue(AObject).AsExtended = 0 then + JSONObject.AddPair(f, TJSONNull.Create) + else + JSONObject.AddPair(f, ISODateTimeToString(_property.GetValue(AObject).AsExtended)) + end + else if _property.PropertyType.QualifiedName = 'System.TTime' then + JSONObject.AddPair(f, ISOTimeToString(_property.GetValue(AObject).AsExtended)) + else + JSONObject.AddPair(f, TJSONNumber.Create(_property.GetValue(AObject).AsExtended)); + } + end; + tkString, tkLString, tkWString, tkUString: + JSONObject.AddPair(f, _property.GetValue(AObject).AsString); + tkEnumeration: + begin + JSONObject.AddPair(f, SerializeEnumerationProperty(AObject, _property)); + // if _property.PropertyType.QualifiedName = 'System.Boolean' then + // begin + // if _property.GetValue(AObject).AsBoolean then + // JSONObject.AddPair(f, TJSONTrue.Create) + // else + // JSONObject.AddPair(f, TJSONFalse.Create); + // end + // else + // begin + // JSONObject.AddPair(f, TJSONNumber.Create(_property.GetValue(AObject).AsOrdinal)); + // end; + end; + tkRecord: + begin + if _property.PropertyType.QualifiedName = 'System.SysUtils.TTimeStamp' then + begin + ts := _property.GetValue(AObject).AsType; + JSONObject.AddPair(f, TJSONNumber.Create(TimeStampToMsecs(ts))); + end; + end; + tkClass: + begin + o := _property.GetValue(AObject).AsObject; + if Assigned(o) then + begin + if TDuckTypedList.CanBeWrappedAsList(o) then + begin + if Mapper.HasAttribute(_property, attr) or + Mapper.HasAttribute(_property.PropertyType, attr) then + begin + list := WrapAsList(o); + if Assigned(list) then + begin + Arr := TJSONArray.Create; + JSONObject.AddPair(f, Arr); + for Obj in list do + if Assigned(Obj) then // nil element into the list are not serialized + Arr.AddElement(ObjectToJSONObject(Obj)); + end; + end + else //Ezequiel J. Müller convert regular list + begin + ListCount := ctx.GetType(o.ClassInfo).GetProperty('Count').GetValue(o).AsInteger; + ListItems := ctx.GetType(o.ClassInfo).GetIndexedProperty('Items').ReadMethod; + if (ListCount > 0) and (ListItems <> nil) then + begin + Arr := TJSONArray.Create; + JSONObject.AddPair(f, Arr); + for I := 0 to ListCount - 1 do + begin + ListItemValue := ListItems.Invoke(o, [I]); + case ListItemValue.TypeInfo.Kind of + tkInteger: + Arr.AddElement(TJSONNumber.Create(ListItemValue.AsInteger)); + tkInt64: + Arr.AddElement(TJSONNumber.Create(ListItemValue.AsInt64)); + tkFloat: + Arr.AddElement(TJSONNumber.Create(ListItemValue.AsExtended)); + tkString, tkLString, tkWString, tkUString: + Arr.AddElement(TJSONString.Create(ListItemValue.AsString)); + end; + end; + end; + end; + end + else if o is TStream then + begin + if HasAttribute(_property, _attrser) then + begin + // serialize the stream as a normal string... + TStream(o).Position := 0; + SerEnc := TEncoding.GetEncoding(_attrser.Encoding); + sr := TStringStream.Create('', SerEnc); + try + sr.LoadFromStream(TStream(o)); + JSONObject.AddPair(f, sr.DataString); + finally + sr.Free; + end; + end + else + begin + // serialize the stream as Base64 encoded string... + TStream(o).Position := 0; + SS := TStringStream.Create; + try + EncodeStream(TStream(o), SS); + JSONObject.AddPair(f, SS.DataString); + finally + SS.Free; + end; + end; + end + else + begin + JSONObject.AddPair(f, ObjectToJSONObject(_property.GetValue(AObject).AsObject)); + end; + end + else + begin + if HasAttribute(_property) then + JSONObject.AddPair(f, '') + else + JSONObject.AddPair(f, TJSONNull.Create); + end; + end; + end; + end; + Result := JSONObject; +end; + +class function Mapper.ObjectToJSONObject(AObject: TObject): TJSONObject; +begin + Result := ObjectToJSONObject(AObject, []); +end; + +class function Mapper.ObjectToJSONObjectFields(AObject: TObject; + AIgnoredProperties: array of string): TJSONObject; +var + _type: TRttiType; + _fields: TArray; + _field: TRttiField; + f: string; + JSONObject: TJSONObject; + Arr: TJSONArray; + list: IWrappedList; + Obj, o: TObject; + DoNotSerializeThis: boolean; + I: Integer; + ThereAreIgnoredProperties: boolean; + JObj: TJSONObject; +begin + ThereAreIgnoredProperties := Length(AIgnoredProperties) > 0; + JSONObject := TJSONObject.Create; + try + // add the $dmvc.classname property to allows a strict deserialization + JSONObject.AddPair(DMVC_CLASSNAME, AObject.QualifiedClassName); + _type := ctx.GetType(AObject.ClassInfo); + _fields := _type.GetFields; + for _field in _fields do + begin + f := GetKeyName(_field, _type); + if ThereAreIgnoredProperties then + begin + DoNotSerializeThis := false; + for I := low(AIgnoredProperties) to high(AIgnoredProperties) do + if SameText(f, AIgnoredProperties[I]) then + begin + DoNotSerializeThis := True; + Break; + end; + if DoNotSerializeThis then + Continue; + end; + case _field.FieldType.TypeKind of + tkInteger, tkInt64: + JSONObject.AddPair(f, TJSONNumber.Create(_field.GetValue(AObject).AsInteger)); + tkFloat: + begin + JSONObject.AddPair(f, SerializeFloatField(AObject, _field)); + end; + tkString, tkLString, tkWString, tkUString: + JSONObject.AddPair(f, _field.GetValue(AObject).AsString); + tkEnumeration: + begin + JSONObject.AddPair(f, SerializeEnumerationField(AObject, _field)); + end; + tkClass: + begin + o := _field.GetValue(AObject).AsObject; + if Assigned(o) then + begin + if TDuckTypedList.CanBeWrappedAsList(o) then + begin + list := WrapAsList(o); + JObj := TJSONObject.Create; + JSONObject.AddPair(f, JObj); + JObj.AddPair(DMVC_CLASSNAME, o.QualifiedClassName); + Arr := TJSONArray.Create; + JObj.AddPair('items', Arr); + for Obj in list do + begin + Arr.AddElement(ObjectToJSONObjectFields(Obj, [])); + end; + end + else + begin + JSONObject.AddPair(f, ObjectToJSONObjectFields(_field.GetValue(AObject) + .AsObject, [])); + end; + end + else + JSONObject.AddPair(f, TJSONNull.Create); + end; + end; + end; + Result := JSONObject; + except + FreeAndNil(JSONObject); + raise; + end; +end; + +class function Mapper.ObjectToJSONObjectFieldsString(AObject: TObject; + AIgnoredProperties: array of string): string; +var + LJObj: TJSONObject; +begin + LJObj := ObjectToJSONObjectFields(AObject, AIgnoredProperties); + try +{$IF CompilerVersion >= 28} + Result := LJObj.ToJSON; +{$ELSE} + Result := LJObj.ToString +{$ENDIF} + finally + LJObj.Free; + end; +end; + +class function Mapper.ObjectToJSONObjectString(AObject: TObject): string; +var + JObj: TJSONObject; +begin + JObj := ObjectToJSONObject(AObject); + try + Result := JObj.ToString; + finally + JObj.Free; + end; +end; + +class function Mapper.PropertyExists(JSONObject: TJSONObject; PropertyName: string): boolean; +begin + Result := Assigned(GetPair(JSONObject, PropertyName)); +end; + +class function Mapper.SerializeEnumerationField(AObject: TObject; ARttiField: TRttiField) + : TJSONValue; +begin + if ARttiField.FieldType.QualifiedName = 'System.Boolean' then + begin + if ARttiField.GetValue(AObject).AsBoolean then + Result := TJSONTrue.Create + else + Result := TJSONFalse.Create; + end + else + begin + Result := TJSONNumber.Create(ARttiField.GetValue(AObject).AsOrdinal); + end; +end; + +class function Mapper.SerializeEnumerationProperty(AObject: TObject; ARTTIProperty: TRttiProperty) + : TJSONValue; +begin + if ARTTIProperty.PropertyType.QualifiedName = 'System.Boolean' then + begin + if ARTTIProperty.GetValue(AObject).AsBoolean then + Result := TJSONTrue.Create + else + Result := TJSONFalse.Create; + end + else + begin + Result := TJSONNumber.Create(ARTTIProperty.GetValue(AObject).AsOrdinal); + end; +end; + +class function Mapper.SerializeFloatField(AObject: TObject; ARttiField: TRttiField): TJSONValue; +begin + if ARttiField.FieldType.QualifiedName = 'System.TDate' then + begin + if ARttiField.GetValue(AObject).AsExtended = 0 then + Result := TJSONNull.Create + else + Result := TJSONString.Create(ISODateToString(ARttiField.GetValue(AObject).AsExtended)) + end + else if ARttiField.FieldType.QualifiedName = 'System.TDateTime' then + begin + if ARttiField.GetValue(AObject).AsExtended = 0 then + Result := TJSONNull.Create + else + Result := TJSONString.Create(ISODateTimeToString(ARttiField.GetValue(AObject).AsExtended)) + end + else if ARttiField.FieldType.QualifiedName = 'System.TTime' then + Result := TJSONString.Create(ISOTimeToString(ARttiField.GetValue(AObject).AsExtended)) + else + Result := TJSONNumber.Create(ARttiField.GetValue(AObject).AsExtended); +end; + +class function Mapper.SerializeFloatProperty(AObject: TObject; ARTTIProperty: TRttiProperty) + : TJSONValue; +begin + if ARTTIProperty.PropertyType.QualifiedName = 'System.TDate' then + begin + if ARTTIProperty.GetValue(AObject).AsExtended = 0 then + Result := TJSONNull.Create + else + Result := TJSONString.Create(ISODateToString(ARTTIProperty.GetValue(AObject).AsExtended)) + end + else if ARTTIProperty.PropertyType.QualifiedName = 'System.TDateTime' then + begin + if ARTTIProperty.GetValue(AObject).AsExtended = 0 then + Result := TJSONNull.Create + else + Result := TJSONString.Create(ISODateTimeToString(ARTTIProperty.GetValue(AObject).AsExtended)) + end + else if ARTTIProperty.PropertyType.QualifiedName = 'System.TTime' then + Result := TJSONString.Create(ISOTimeToString(ARTTIProperty.GetValue(AObject).AsExtended)) + else + Result := TJSONNumber.Create(ARTTIProperty.GetValue(AObject).AsExtended); + + // if ARTTIProperty.PropertyType.QualifiedName = 'System.TDate' then + // Result := TJSONString.Create(ISODateToString(ARTTIProperty.GetValue(AObject).AsExtended)) + // else if ARTTIProperty.PropertyType.QualifiedName = 'System.TDateTime' then + // Result := TJSONString.Create(ISODateTimeToString(ARTTIProperty.GetValue(AObject).AsExtended)) + // else if ARTTIProperty.PropertyType.QualifiedName = 'System.TTime' then + // Result := TJSONString.Create(ISOTimeToString(ARTTIProperty.GetValue(AObject).AsExtended)) + // else + // Result := TJSONNumber.Create(ARTTIProperty.GetValue(AObject).AsExtended); +end; + +class function Mapper.GetKeyName(const ARttiField: TRttiField; AType: TRttiType): string; +var + attrs: TArray; + attr: TCustomAttribute; +begin + // JSONSer property attribute handling + attrs := ARttiField.GetAttributes; + for attr in attrs do + begin + if attr is MapperJSONSer then + Exit(MapperJSONSer(attr).Name); + end; + + // JSONNaming class attribute handling + attrs := AType.GetAttributes; + for attr in attrs do + begin + if attr is MapperJSONNaming then + begin + case MapperJSONNaming(attr).GetKeyCase of + JSONNameUpperCase: + begin + Exit(UpperCase(ARttiField.Name)); + end; + JSONNameLowerCase: + begin + Exit(LowerCase(ARttiField.Name)); + end; + end; + end; + end; + + // Default + Result := ARttiField.Name; +end; + +class function Mapper.GetBooleanDef(JSONObject: TJSONObject; PropertyName: string; + DefaultValue: boolean): boolean; +var + pair: TJSONPair; +begin + pair := GetPair(JSONObject, PropertyName); + if pair = nil then + Exit(DefaultValue); + if pair.JsonValue is TJSONFalse then + Exit(false) + else if pair.JsonValue is TJSONTrue then + Exit(True) + else + raise EMapperException.CreateFmt('Property %s is not a Boolean Property', [PropertyName]); +end; + +class function Mapper.GetInt64Def(JSONObject: TJSONObject; PropertyName: string; + DefaultValue: Int64): Int64; +var + pair: TJSONPair; +begin + pair := GetPair(JSONObject, PropertyName); + if pair = nil then + Exit(DefaultValue); + if pair.JsonValue is TJSONNumber then + Exit(TJSONNumber(pair.JsonValue).AsInt64) + else + raise EMapperException.CreateFmt('Property %s is not a Int64 Property', [PropertyName]); +end; + +class function Mapper.GetIntegerDef(JSONObject: TJSONObject; PropertyName: string; + DefaultValue: Integer): Integer; +var + pair: TJSONPair; +begin + pair := GetPair(JSONObject, PropertyName); + if pair = nil then + Exit(DefaultValue); + if pair.JsonValue is TJSONNumber then + Exit(TJSONNumber(pair.JsonValue).AsInt) + else + raise EMapperException.CreateFmt('Property %s is not an Integer Property', [PropertyName]); + +end; + +class function Mapper.GetJSONArray(JSONObject: TJSONObject; PropertyName: string): TJSONArray; +var + pair: TJSONPair; +begin + pair := GetPair(JSONObject, PropertyName); + if pair = nil then + Exit(nil); + if pair.JsonValue is TJSONArray then + Exit(TJSONArray(pair.JsonValue)) + else + raise EMapperException.Create('Property is not a JSONArray'); + +end; + +class function Mapper.GetJSONObj(JSONObject: TJSONObject; PropertyName: string): TJSONObject; +var + pair: TJSONPair; +begin + pair := GetPair(JSONObject, PropertyName); + if pair = nil then + Exit(nil); + if pair.JsonValue is TJSONObject then + Exit(TJSONObject(pair.JsonValue)) + else + raise EMapperException.Create('Property is not a JSONObject'); +end; + +class function Mapper.GetKeyName(const ARttiProp: TRttiProperty; AType: TRttiType): string; +var + attrs: TArray; + attr: TCustomAttribute; +begin + // JSONSer property attribute handling + attrs := ARttiProp.GetAttributes; + for attr in attrs do + begin + if attr is MapperJSONSer then + Exit(MapperJSONSer(attr).Name); + end; + + // JSONNaming class attribute handling + attrs := AType.GetAttributes; + for attr in attrs do + begin + if attr is MapperJSONNaming then + begin + case MapperJSONNaming(attr).GetKeyCase of + JSONNameUpperCase: + begin + Exit(UpperCase(ARttiProp.Name)); + end; + JSONNameLowerCase: + begin + Exit(LowerCase(ARttiProp.Name)); + end; + end; + end; + end; + + // Default + Result := ARttiProp.Name; +end; + +class function Mapper.GetNumberDef(JSONObject: TJSONObject; PropertyName: string; + DefaultValue: Extended): Extended; +var + pair: TJSONPair; +begin + pair := GetPair(JSONObject, PropertyName); + if pair = nil then + Exit(DefaultValue); + if pair.JsonValue is TJSONNumber then + Exit(TJSONNumber(pair.JsonValue).AsDouble) + else + raise EMapperException.Create('Property is not a Number Property'); +end; + +class function Mapper.GetPair(JSONObject: TJSONObject; PropertyName: string): TJSONPair; +var + pair: TJSONPair; +begin + if not Assigned(JSONObject) then + raise EMapperException.Create('JSONObject is nil'); + pair := JSONObject.Get(PropertyName); + Result := pair; +end; + +class function Mapper.GetProperty(Obj: TObject; const PropertyName: string): TValue; +var + Prop: TRttiProperty; + ARTTIType: TRttiType; +begin + ARTTIType := ctx.GetType(Obj.ClassType); + if not Assigned(ARTTIType) then + raise EMapperException.CreateFmt('Cannot get RTTI for type [%s]', [ARTTIType.ToString]); + Prop := ARTTIType.GetProperty(PropertyName); + if not Assigned(Prop) then + raise EMapperException.CreateFmt('Cannot get RTTI for property [%s.%s]', + [ARTTIType.ToString, PropertyName]); + if Prop.IsReadable then + Result := Prop.GetValue(Obj) + else + raise EMapperException.CreateFmt('Property is not readable [%s.%s]', + [ARTTIType.ToString, PropertyName]); +end; + +class function Mapper.GetStringDef(JSONObject: TJSONObject; + PropertyName, DefaultValue: string): string; +var + pair: TJSONPair; +begin + pair := GetPair(JSONObject, PropertyName); + if pair = nil then + Exit(DefaultValue); + if pair.JsonValue is TJSONString then + Exit(TJSONString(pair.JsonValue).Value) + else + raise EMapperException.Create('Property is not a String Property'); +end; + +class function Mapper.HasAttribute(ARTTIMember: TRttiNamedObject; out AAttribute: T): boolean; +var + attrs: TArray; + attr: TCustomAttribute; +begin + AAttribute := nil; + Result := false; + attrs := ARTTIMember.GetAttributes; + for attr in attrs do + if attr is T then + begin + AAttribute := T(attr); + Exit(True); + end; +end; + +class function Mapper.HasAttribute(ARTTIMember: TRttiNamedObject): boolean; +var + attrs: TArray; + attr: TCustomAttribute; +begin + Result := false; + attrs := ARTTIMember.GetAttributes; + for attr in attrs do + if attr is T then + Exit(True); +end; + +class procedure Mapper.JSONArrayToDataSet(AJSONArray: TJSONArray; ADataSet: TDataSet; + AJSONArrayInstanceOwner: boolean); +begin + JSONArrayToDataSet(AJSONArray, ADataSet, TArray.Create(), AJSONArrayInstanceOwner); +end; + +class procedure Mapper.JSONArrayToDataSet(AJSONArray: TJSONArray; ADataSet: TDataSet; + AIgnoredFields: TArray; AJSONArrayInstanceOwner: boolean; + AFieldNamePolicy: TFieldNamePolicy); +var + I: Integer; +begin + for I := 0 to AJSONArray.Size - 1 do + begin + ADataSet.Append; + Mapper.JSONObjectToDataSet(AJSONArray.Get(I) as TJSONObject, ADataSet, AIgnoredFields, false, + AFieldNamePolicy); + ADataSet.Post; + end; + if AJSONArrayInstanceOwner then + AJSONArray.Free; +end; + +class function Mapper.JSONArrayToObjectList(AListOf: TClass; AJSONArray: TJSONArray; + AInstanceOwner: boolean = True; AOwnsChildObjects: boolean = True): TObjectList; +var + I: Integer; +begin + Result := nil; + if Assigned(AJSONArray) then + begin + Result := TObjectList.Create(AOwnsChildObjects); + for I := 0 to AJSONArray.Size - 1 do + Result.Add(Mapper.JSONObjectToObject(AListOf, AJSONArray.Get(I) as TJSONObject)); + if AInstanceOwner then + AJSONArray.Free; + end; +end; + +class procedure Mapper.JSONArrayToObjectList(AList: IWrappedList; AListOf: TClass; + AJSONArray: TJSONArray; AInstanceOwner: boolean = True; AOwnsChildObjects: boolean = True); +var + I: Integer; +begin + if Assigned(AJSONArray) then + begin + AList.OwnsObjects := AOwnsChildObjects; + for I := 0 to AJSONArray.Size - 1 do + AList.Add(Mapper.JSONObjectToObject(AListOf, AJSONArray.Get(I) as TJSONObject)); + if AInstanceOwner then + AJSONArray.Free; + end; +end; + +class procedure Mapper.JSONArrayToObjectList(AList: TObjectList; AJSONArray: TJSONArray; + AInstanceOwner, AOwnsChildObjects: boolean); +var + I: Integer; +begin + if Assigned(AJSONArray) then + begin + for I := 0 to AJSONArray.Size - 1 do + AList.Add(Mapper.JSONObjectToObject(AJSONArray.Get(I) as TJSONObject)); + if AInstanceOwner then + AJSONArray.Free; + end; +end; + +class function Mapper.JSONArrayToObjectList(AJSONArray: TJSONArray; AInstanceOwner: boolean; + AOwnsChildObjects: boolean): TObjectList; +begin + Result := TObjectList.Create(AOwnsChildObjects); + JSONArrayToObjectList(Result, AJSONArray, AInstanceOwner, AOwnsChildObjects); +end; + +class procedure Mapper.InternalJSONObjectFieldsToObject(ctx: TRTTIContext; AJSONObject: TJSONObject; + AObject: TObject); + procedure RaiseExceptForField(FieldName: string); + begin + raise EMapperException.Create(FieldName + ' key field is not present in the JSONObject'); + end; + +var + _type: TRttiType; + _fields: TArray; + _field: TRttiField; + f: string; + jvalue: TJSONValue; + v: TValue; + o: TObject; + list: IWrappedList; + I: Integer; + Arr: TJSONArray; + n: TJSONNumber; + SerStreamASString: string; + sw: TStreamWriter; + SS: TStringStream; + _attrser: MapperSerializeAsString; + SerEnc: TEncoding; + LClassName: string; + LJSONKeyIsNotPresent: boolean; +begin + jvalue := nil; + _type := ctx.GetType(AObject.ClassInfo); + _fields := _type.GetFields; + for _field in _fields do + begin + if HasAttribute(_field) then + Continue; + f := GetKeyName(_field, _type); + if Assigned(AJSONObject.Get(f)) then + begin + LJSONKeyIsNotPresent := false; + jvalue := AJSONObject.Get(f).JsonValue; + end + else + begin + LJSONKeyIsNotPresent := True; + end; + + case _field.FieldType.TypeKind of + tkEnumeration: + begin + if LJSONKeyIsNotPresent then + RaiseExceptForField(_field.Name); + if _field.FieldType.QualifiedName = 'System.Boolean' then + begin + if jvalue is TJSONTrue then + _field.SetValue(TObject(AObject), True) + else if jvalue is TJSONFalse then + _field.SetValue(TObject(AObject), false) + else + raise EMapperException.Create('Invalid value for property ' + _field.Name); + end + else // it is an enumerated value but it's not a boolean. + begin + TValue.Make((jvalue as TJSONNumber).AsInt, _field.FieldType.Handle, v); + _field.SetValue(TObject(AObject), v); + end; + end; + tkInteger, tkInt64: + begin + if LJSONKeyIsNotPresent then + _field.SetValue(TObject(AObject), 0) + else + _field.SetValue(TObject(AObject), StrToIntDef(jvalue.Value, 0)); + end; + tkFloat: + begin + if LJSONKeyIsNotPresent then + begin + _field.SetValue(TObject(AObject), 0); + end + else + begin + if _field.FieldType.QualifiedName = 'System.TDate' then + begin + if jvalue is TJSONNull then + _field.SetValue(TObject(AObject), 0) + else + _field.SetValue(TObject(AObject), ISOStrToDateTime(jvalue.Value + ' 00:00:00')) + end + else if _field.FieldType.QualifiedName = 'System.TDateTime' then + begin + if jvalue is TJSONNull then + _field.SetValue(TObject(AObject), 0) + else + _field.SetValue(TObject(AObject), ISOStrToDateTime(jvalue.Value)) + end + else if _field.FieldType.QualifiedName = 'System.TTime' then + begin + if jvalue is TJSONString then + _field.SetValue(TObject(AObject), ISOStrToTime(jvalue.Value)) + else + raise EMapperException.CreateFmt('Cannot deserialize [%s], expected [%s] got [%s]', + [_field.Name, 'TJSONString', jvalue.ClassName]); + end + else { if _field.PropertyType.QualifiedName = 'System.Currency' then } + begin + if jvalue is TJSONNumber then + _field.SetValue(TObject(AObject), TJSONNumber(jvalue).AsDouble) + else + raise EMapperException.CreateFmt('Cannot deserialize [%s], expected [%s] got [%s]', + [_field.Name, 'TJSONNumber', jvalue.ClassName]); + end; + end; + end; + tkString, tkLString, tkWString, tkUString: + begin + if LJSONKeyIsNotPresent then + _field.SetValue(TObject(AObject), '') + else + _field.SetValue(TObject(AObject), jvalue.Value); + end; + tkRecord: + begin + if _field.FieldType.QualifiedName = 'System.SysUtils.TTimeStamp' then + begin + if LJSONKeyIsNotPresent then + begin + _field.SetValue(TObject(AObject), TValue.From(MSecsToTimeStamp(0))); + end + else + begin + n := jvalue as TJSONNumber; + _field.SetValue(TObject(AObject), + TValue.From(MSecsToTimeStamp(n.AsInt64))); + end; + end; + end; + tkClass: // try to restore child properties... but only if the collection is not nil!!! + begin + o := _field.GetValue(TObject(AObject)).AsObject; + if LJSONKeyIsNotPresent then + begin + o.Free; + o := nil; + _field.SetValue(AObject, nil); + end; + + if Assigned(o) then + begin + if o is TStream then + begin + if jvalue is TJSONString then + begin + SerStreamASString := TJSONString(jvalue).Value; + end + else + raise EMapperException.Create('Expected JSONString in ' + AJSONObject.Get(f) + .JsonString.Value); + + if HasAttribute(_field, _attrser) then + begin + // serialize the stream as a normal string... + TStream(o).Position := 0; + SerEnc := TEncoding.GetEncoding(_attrser.Encoding); + SS := TStringStream.Create(SerStreamASString, SerEnc); + try + SS.Position := 0; + TStream(o).CopyFrom(SS, SS.Size); + finally + SS.Free; + end; + end + else + begin + // deserialize the stream as Base64 encoded string... + TStream(o).Position := 0; + sw := TStreamWriter.Create(TStream(o)); + try + sw.Write(DecodeString(SerStreamASString)); + finally + sw.Free; + end; + end; + end + else if TDuckTypedList.CanBeWrappedAsList(o) then + begin // restore collection + if not(jvalue is TJSONObject) then + raise EMapperException.Create('Wrong serialization for ' + o.QualifiedClassName); + LClassName := TJSONObject(jvalue).Get(DMVC_CLASSNAME).JsonValue.Value; + if o = nil then // recreate the object as it should be + begin + o := TRTTIUtils.CreateObject(LClassName); + end; + jvalue := TJSONObject(jvalue).Get('items').JsonValue; + if jvalue is TJSONArray then + begin + Arr := TJSONArray(jvalue); + begin + list := WrapAsList(o); + for I := 0 to Arr.Size - 1 do + begin + list.Add(Mapper.JSONObjectFieldsToObject(Arr.Get(I) as TJSONObject)); + end; + end; + end + else + raise EMapperException.Create('Cannot restore ' + f + + ' because the related json property is not an array'); + end + else // try to deserialize into the property... but the json MUST be an object + begin + if jvalue is TJSONObject then + begin + InternalJSONObjectFieldsToObject(ctx, TJSONObject(jvalue), o); + end + else if jvalue is TJSONNull then + begin + FreeAndNil(o); + _field.SetValue(AObject, nil) + end + else + raise EMapperException.Create('Cannot deserialize property ' + _field.Name); + end; + end; + end; + end; + end; +end; + +class procedure Mapper.InternalJSONObjectToObject(ctx: TRTTIContext; AJSONObject: TJSONObject; + AObject: TObject); +var + _type: TRttiType; + _fields: TArray; + _field: TRttiProperty; + f: string; + jvalue: TJSONValue; + v: TValue; + o: TObject; + list: IWrappedList; + I: Integer; + cref: TClass; + attr: MapperItemsClassType; + Arr: TJSONArray; + n: TJSONNumber; + SerStreamASString: string; + // EncBytes: TBytes; + sw: TStreamWriter; + SS: TStringStream; + _attrser: MapperSerializeAsString; + SerEnc: TEncoding; + ListMethod: TRttiMethod; + ListItem: TValue; + ListParam: TRttiParameter; +begin + _type := ctx.GetType(AObject.ClassInfo); + _fields := _type.GetProperties; + for _field in _fields do + begin + if ((not _field.IsWritable) and (_field.PropertyType.TypeKind <> tkClass)) or + (HasAttribute(_field)) then + Continue; + f := GetKeyName(_field, _type); + if Assigned(AJSONObject.Get(f)) then + jvalue := AJSONObject.Get(f).JsonValue + else + Continue; + case _field.PropertyType.TypeKind of + tkEnumeration: + begin + if _field.PropertyType.QualifiedName = 'System.Boolean' then + begin + if jvalue is TJSONTrue then + _field.SetValue(TObject(AObject), True) + else if jvalue is TJSONFalse then + _field.SetValue(TObject(AObject), false) + else + raise EMapperException.Create('Invalid value for property ' + _field.Name); + end + else // it is an enumerated value but it's not a boolean. + begin + TValue.Make((jvalue as TJSONNumber).AsInt, _field.PropertyType.Handle, v); + _field.SetValue(TObject(AObject), v); + end; + end; + tkInteger, tkInt64: + _field.SetValue(TObject(AObject), StrToIntDef(jvalue.Value, 0)); + tkFloat: + begin + if _field.PropertyType.QualifiedName = 'System.TDate' then + begin + if jvalue is TJSONNull then + _field.SetValue(TObject(AObject), 0) + else + _field.SetValue(TObject(AObject), ISOStrToDateTime(jvalue.Value + ' 00:00:00')) + end + else if _field.PropertyType.QualifiedName = 'System.TDateTime' then + begin + if jvalue is TJSONNull then + _field.SetValue(TObject(AObject), 0) + else + _field.SetValue(TObject(AObject), ISOStrToDateTime(jvalue.Value)) + end + else if _field.PropertyType.QualifiedName = 'System.TTime' then + begin + if jvalue is TJSONString then + _field.SetValue(TObject(AObject), ISOStrToTime(jvalue.Value)) + else + raise EMapperException.CreateFmt('Cannot deserialize [%s], expected [%s] got [%s]', + [_field.Name, 'TJSONString', jvalue.ClassName]); + end + else { if _field.PropertyType.QualifiedName = 'System.Currency' then } + begin + if jvalue is TJSONNumber then + _field.SetValue(TObject(AObject), TJSONNumber(jvalue).AsDouble) + else + raise EMapperException.CreateFmt('Cannot deserialize [%s], expected [%s] got [%s]', + [_field.Name, 'TJSONNumber', jvalue.ClassName]); + end { + else + begin + _field.SetValue(TObject(AObject), (jvalue as TJSONNumber).AsDouble) + end; } + end; + tkString, tkLString, tkWString, tkUString: + begin + _field.SetValue(TObject(AObject), jvalue.Value); + end; + tkRecord: + begin + if _field.PropertyType.QualifiedName = 'System.SysUtils.TTimeStamp' then + begin + n := jvalue as TJSONNumber; + _field.SetValue(TObject(AObject), TValue.From(MSecsToTimeStamp(n.AsInt64))); + end; + end; + tkClass: // try to restore child properties... but only if the collection is not nil!!! + begin + o := _field.GetValue(TObject(AObject)).AsObject; + if Assigned(o) then + begin + if o is TStream then + begin + if jvalue is TJSONString then + begin + SerStreamASString := TJSONString(jvalue).Value; + end + else + raise EMapperException.Create('Expected JSONString in ' + AJSONObject.Get(f) + .JsonString.Value); + + if HasAttribute(_field, _attrser) then + begin + // serialize the stream as a normal string... + TStream(o).Position := 0; + SerEnc := TEncoding.GetEncoding(_attrser.Encoding); + SS := TStringStream.Create(SerStreamASString, SerEnc); + try + SS.Position := 0; + TStream(o).CopyFrom(SS, SS.Size); + finally + SS.Free; + end; + end + else + begin + // deserialize the stream as Base64 encoded string... + TStream(o).Position := 0; + sw := TStreamWriter.Create(TStream(o)); + try + sw.Write(DecodeString(SerStreamASString)); + finally + sw.Free; + end; + end; + end + else if TDuckTypedList.CanBeWrappedAsList(o) then + begin // restore collection + if jvalue is TJSONArray then + begin + Arr := TJSONArray(jvalue); + // look for the MapperItemsClassType on the property itself or on the property type + if Mapper.HasAttribute(_field, attr) or + Mapper.HasAttribute(_field.PropertyType, attr) then + begin + cref := attr.Value; + list := WrapAsList(o); + for I := 0 to Arr.Size - 1 do + begin + list.Add(Mapper.JSONObjectToObject(cref, Arr.Get(I) as TJSONObject)); + end; + end + else //Ezequiel J. Müller convert regular list + begin + ListMethod := ctx.GetType(o.ClassInfo).GetMethod('Add'); + if (ListMethod <> nil) then + begin + for I := 0 to Arr.Size - 1 do + begin + ListItem := TValue.Empty; + + for ListParam in ListMethod.GetParameters do + case ListParam.ParamType.TypeKind of + tkInteger, tkInt64: + ListItem := StrToIntDef(Arr.Get(I).Value, 0); + tkFloat: + ListItem := TJSONNumber(Arr.Get(I).Value).AsDouble; + tkString, tkLString, tkWString, tkUString: + ListItem := Arr.Get(I).Value; + end; + + if not ListItem.IsEmpty then + ListMethod.Invoke(o, [ListItem]); + end; + end; + end; + end + else + raise EMapperException.Create('Cannot restore ' + f + + ' because the related json property is not an array'); + end + else // try to deserialize into the property... but the json MUST be an object + begin + if jvalue is TJSONObject then + begin + InternalJSONObjectToObject(ctx, TJSONObject(jvalue), o); + end + else if jvalue is TJSONNull then + begin + FreeAndNil(o); + _field.SetValue(AObject, nil); + end + else + raise EMapperException.Create('Cannot deserialize property ' + _field.Name); + end; + end; + end; + end; + end; +end; + +class function Mapper.JSONObjectToObject(Clazz: TClass; AJSONObject: TJSONObject): TObject; +var + AObject: TObject; +begin + AObject := TRTTIUtils.CreateObject(Clazz.QualifiedClassName); + try + InternalJSONObjectToObject(ctx, AJSONObject, AObject); + Result := AObject; + except + //Ezequiel J. Müller + //It is important to pass on the exception, to be able to identify the problem you are experiencing. + on E: Exception do + begin + FreeAndNil(AObject); + raise EMapperException.Create(E.Message); + end; + end; +end; + +class procedure Mapper.JSONObjectToDataSet(AJSONObject: TJSONObject; ADataSet: TDataSet; + AJSONObjectInstanceOwner: boolean); +begin + JSONObjectToDataSet(AJSONObject, ADataSet, TArray.Create(), AJSONObjectInstanceOwner); +end; + +class function Mapper.JSONObjectFieldsToObject(AJSONObject: TJSONObject): TObject; +var + lJClassName: TJSONString; + LObj: TObject; +begin +{$IF CompilerVersion <= 26} + if Assigned(AJSONObject.Get(DMVC_CLASSNAME)) then + begin + lJClassName := AJSONObject.Get(DMVC_CLASSNAME).JsonValue as TJSONString; + end + else + raise EMapperException.Create('No $classname property in the JSON object'); +{$ELSE} + if not AJSONObject.TryGetValue(DMVC_CLASSNAME, lJClassName) then + raise EMapperException.Create('No $classname property in the JSON object'); +{$ENDIF} + LObj := TRTTIUtils.CreateObject(lJClassName.Value); + try + InternalJSONObjectFieldsToObject(ctx, AJSONObject, LObj); + Result := LObj; + except + FreeAndNil(LObj); + raise; + end; +end; + +class function Mapper.JSONObjectStringToObject(const AJSONObjectString: string): T; +var + JObj: TJSONObject; +begin + JObj := TJSONObject.ParseJSONValue(AJSONObjectString) as TJSONObject; + try + Result := JSONObjectToObject(JObj); + finally + JObj.Free; + end; +end; + +class procedure Mapper.JSONObjectToDataSet(AJSONObject: TJSONObject; ADataSet: TDataSet; + AIgnoredFields: TArray; AJSONObjectInstanceOwner: boolean; + AFieldNamePolicy: TFieldNamePolicy); +var + I: Integer; + key: string; + v: TJSONValue; + jp: TJSONPair; + fs: TFormatSettings; + MS: TMemoryStream; + SS: TStringStream; +begin + for I := 0 to ADataSet.FieldCount - 1 do + begin + if ContainsFieldName(ADataSet.Fields[I].FieldName, AIgnoredFields) then + Continue; + + // Name policy { ***** Daniele Spinetti ***** } + case AFieldNamePolicy of + fpLowerCase: + key := LowerCase(ADataSet.Fields[I].FieldName); + fpUpperCase: + key := UpperCase(ADataSet.Fields[I].FieldName); + fpAsIs: + key := ADataSet.Fields[I].FieldName; + end; + + v := nil; + jp := AJSONObject.Get(key); + if Assigned(jp) then + if not(jp.JsonValue is TJSONNull) then + v := AJSONObject.Get(key).JsonValue; + if not Assigned(v) then + begin + ADataSet.Fields[I].Clear; + Continue; + end; + + case ADataSet.Fields[I].DataType of + TFieldType.ftInteger, TFieldType.ftAutoInc, TFieldType.ftSmallint, TFieldType.ftShortint: + begin + ADataSet.Fields[I].AsInteger := (v as TJSONNumber).AsInt; + end; + TFieldType.ftLargeint: + begin + ADataSet.Fields[I].AsLargeInt := (v as TJSONNumber).AsInt64; + end; + TFieldType.ftSingle, TFieldType.ftFloat: + begin + ADataSet.Fields[I].AsFloat := (v as TJSONNumber).AsDouble; + end; + ftString, ftWideString, ftMemo, ftWideMemo: + begin + ADataSet.Fields[I].AsString := (v as TJSONString).Value; + end; + TFieldType.ftDate: + begin + ADataSet.Fields[I].AsDateTime := ISOStrToDate((v as TJSONString).Value); + end; + TFieldType.ftDateTime: + begin + ADataSet.Fields[I].AsDateTime := ISOStrToDateTime((v as TJSONString).Value); + end; + TFieldType.ftTimeStamp: + begin + ADataSet.Fields[I].AsSQLTimeStamp := StrToSQLTimeStamp((v as TJSONString).Value); + end; + TFieldType.ftCurrency: + begin + fs.DecimalSeparator := '.'; +{$IF CompilerVersion <= 27} + ADataSet.Fields[I].AsCurrency := StrToCurr((v as TJSONString).Value, fs); +{$ELSE} // Delphi XE7 introduces method "ToJSON" to fix some old bugs... + ADataSet.Fields[I].AsCurrency := StrToCurr((v as TJSONNumber).ToJSON, fs); +{$ENDIF} + end; + TFieldType.ftFMTBcd: + begin + ADataSet.Fields[I].AsBcd := DoubleToBcd((v as TJSONNumber).AsDouble); + end; + TFieldType.ftGraphic, TFieldType.ftBlob, TFieldType.ftStream: + begin + MS := TMemoryStream.Create; + try + SS := TStringStream.Create((v as TJSONString).Value, TEncoding.ASCII); + try + DecodeStream(SS, MS); + MS.Position := 0; + TBlobField(ADataSet.Fields[I]).LoadFromStream(MS); + finally + SS.Free; + end; + finally + MS.Free; + end; + end; + // else + // raise EMapperException.Create('Cannot find type for field ' + key); + end; + end; + if AJSONObjectInstanceOwner then + FreeAndNil(AJSONObject); +end; + +class function Mapper.JSONObjectToObject(ClazzName: string; AJSONObject: TJSONObject): TObject; +var + AObject: TObject; + _rttiType: TRttiType; +begin + _rttiType := Mapper.ctx.FindType(ClazzName); + if Assigned(_rttiType) then + begin + AObject := TRTTIUtils.CreateObject(_rttiType); + try + InternalJSONObjectToObject(ctx, AJSONObject, AObject); + Result := AObject; + except + AObject.Free; + // Result := nil; + raise; // added 20140630 + end; + end + else + raise EMapperException.CreateFmt('Class not found [%s]', [ClazzName]); +end; + +class function Mapper.JSONObjectToObject(AJSONObject: TJSONObject): T; +begin + if not Assigned(AJSONObject) then + raise EMapperException.Create('JSONObject not assigned'); + Result := Mapper.JSONObjectToObject(T.QualifiedClassName, AJSONObject) as T; + // Result := JSONObjectToObject(TObject.ClassInfo, AJSONObject); +end; + +class function Mapper.JSONObjectToObjectFields(AJSONObject: TJSONObject): T; +var + _type: TRttiType; + _fields: TArray; + _field: TRttiField; + f: string; + AObject: T; + jvalue: TJSONValue; +begin + AObject := T.Create; + try + _type := ctx.GetType(AObject.ClassInfo); + _fields := _type.GetFields; + for _field in _fields do + begin + f := LowerCase(_field.Name); + Delete(f, 1, 1); + if Assigned(AJSONObject.Get(f)) then + jvalue := AJSONObject.Get(f).JsonValue + else + Continue; + case _field.FieldType.TypeKind of + tkInteger, tkInt64: + _field.SetValue(TObject(AObject), StrToIntDef(jvalue.Value, 0)); + tkFloat: + begin + if _field.FieldType.QualifiedName = 'System.TDate' then + _field.SetValue(TObject(AObject), StrToDate(jvalue.Value)) + else if _field.FieldType.QualifiedName = 'System.TDateTime' then + _field.SetValue(TObject(AObject), StrToDateTime(jvalue.Value)) + else + _field.SetValue(TObject(AObject), (jvalue as TJSONNumber).AsDouble) + end; + tkString, tkLString, tkWString, tkUString: + begin + _field.SetValue(TObject(AObject), jvalue.Value); + end; + end; + end; + Result := AObject; + except + AObject.Free; + AObject := nil; + Result := nil; + end; +end; + +class procedure Mapper.DataSetToObjectList(ADataSet: TDataSet; AObjectList: TObjectList; + ACloseDataSetAfterScroll: boolean); +var + Obj: T; + SavedPosition: TArray; +begin + ADataSet.DisableControls; + try + SavedPosition := ADataSet.Bookmark; + while not ADataSet.Eof do + begin + Obj := T.Create; + DataSetToObject(ADataSet, Obj); + AObjectList.Add(Obj); + ADataSet.Next; + end; + if ADataSet.BookmarkValid(SavedPosition) then + ADataSet.Bookmark := SavedPosition; + finally + ADataSet.EnableControls; + end; + if ACloseDataSetAfterScroll then + ADataSet.Close; +end; +// +// class procedure Mapper.DataSetToXML(ADataSet: TDataSet; +// XMLDocument: String; ADataSetInstanceOwner: boolean); +// var +// Xml: IXMLDocument; +// Row: IXMLNode; +// begin +// DefaultDOMVendor := 'ADOM XML v4'; +// Xml := NewXMLDocument(); +// while not ADataSet.Eof do +// begin +// Row := Xml.CreateNode('row'); +// // Row := Xml.DocumentElement.AddChild('row'); +// // DataSetRowToXML(ADataSet, Row, false); +// Xml.ChildNodes.Add(Row); +// break; +// ADataSet.Next; +// end; +// if ADataSetInstanceOwner then +// FreeAndNil(ADataSet); +// Xml.SaveToXML(XMLDocument); +// end; +// +// class procedure Mapper.DataSetRowToXML(ADataSet: TDataSet; +// Row: IXMLNode; ADataSetInstanceOwner: boolean); +// var +// I: Integer; +// key: string; +// dt: TDateTime; +// tt: TTime; +// Time: TTimeStamp; +// ts: TSQLTimeStamp; +// begin +// for I := 0 to ADataSet.FieldCount - 1 do +// begin +// key := LowerCase(ADataSet.Fields[I].FieldName); +// case ADataSet.Fields[I].DataType of +// TFieldType.ftInteger, TFieldType.ftSmallint, TFieldType.ftShortint: +// Row.Attributes[key] := ADataSet.Fields[I].AsInteger; +// // AJSONObject.AddPair(key, TJSONNumber.Create(ADataSet.Fields[I].AsInteger)); +// TFieldType.ftLargeint: +// begin +// Row.Attributes[key] := ADataSet.Fields[I].AsLargeInt; +// end; +// TFieldType.ftSingle, TFieldType.ftFloat: +// Row.Attributes[key] := ADataSet.Fields[I].AsFloat; +// ftString, ftWideString, ftMemo: +// Row.Attributes[key] := ADataSet.Fields[I].AsWideString; +// TFieldType.ftDate: +// begin +// if not ADataSet.Fields[I].IsNull then +// begin +// Row.Attributes[key] := ISODateToString(ADataSet.Fields[I].AsDateTime); +// end +// end; +// TFieldType.ftDateTime: +// begin +// if not ADataSet.Fields[I].IsNull then +// begin +// Row.Attributes[key] := ISODateTimeToString(ADataSet.Fields[I].AsDateTime); +// end +// end; +// TFieldType.ftTimeStamp: +// begin +// if not ADataSet.Fields[I].IsNull then +// begin +// ts := ADataSet.Fields[I].AsSQLTimeStamp; +// Row.Attributes[key] := SQLTimeStampToStr('hh:nn:ss', ts); +// end +// end; +// TFieldType.ftCurrency: +// begin +// if not ADataSet.Fields[I].IsNull then +// begin +// Row.Attributes[key] := FormatCurr('0.00##', ADataSet.Fields[I].AsCurrency); +// end +// end; +// TFieldType.ftFMTBcd: +// begin +// if not ADataSet.Fields[I].IsNull then +// begin +// Row.Attributes[key] := BcdToDouble(ADataSet.Fields[I].AsBcd); +// end +// end +// else +// raise EMapperException.Create('Cannot find type for field ' + key); +// end; +// end; +// if ADataSetInstanceOwner then +// FreeAndNil(ADataSet); +// end; + +{$IF CompilerVersion > 25} + + +class procedure Mapper.ObjectToFDParameters(AFDParams: TFDParams; AObject: TObject; + AParamPrefix: string); +var + I: Integer; + pname: string; + _rttiType: TRttiType; + obj_fields: TArray; + obj_field: TRttiProperty; + obj_field_attr: MapperColumnAttribute; + Map: TObjectDictionary; + f: TRttiProperty; + fv: TValue; + PrefixLength: Integer; + + function KindToFieldType(AKind: TTypeKind; AProp: TRttiProperty): TFieldType; + begin + case AKind of + tkInteger: + Result := ftInteger; + tkFloat: + begin // daniele teti 2014-05-23 + if AProp.PropertyType.QualifiedName = 'System.TDate' then + Result := ftDate + else if AProp.PropertyType.QualifiedName = 'System.TDateTime' then + Result := ftDateTime + else if AProp.PropertyType.QualifiedName = 'System.TTime' then + Result := ftTime + else + Result := ftFloat; + end; + tkChar, tkString: + Result := ftString; + tkWChar, tkUString, tkLString, tkWString: + Result := ftWideString; + tkVariant: + Result := ftVariant; + tkArray: + Result := ftArray; + tkInterface: + Result := ftInterface; + tkInt64: + Result := ftLongWord; + else + Result := ftUnknown; + end; + end; + +begin + PrefixLength := Length(AParamPrefix); + Map := TObjectDictionary.Create; + try + if Assigned(AObject) then + begin + _rttiType := ctx.GetType(AObject.ClassType); + obj_fields := _rttiType.GetProperties; + for obj_field in obj_fields do + begin + if HasAttribute(obj_field, obj_field_attr) then + begin + Map.Add(MapperColumnAttribute(obj_field_attr).FieldName.ToLower, obj_field); + end + else + begin + Map.Add(obj_field.Name.ToLower, obj_field); + end + end; + end; + for I := 0 to AFDParams.Count - 1 do + begin + pname := AFDParams[I].Name.ToLower; + if pname.StartsWith(AParamPrefix, True) then + Delete(pname, 1, PrefixLength); + if Map.TryGetValue(pname, f) then + begin + fv := f.GetValue(AObject); + AFDParams[I].DataType := KindToFieldType(fv.Kind, f); + // DmitryG - 2014-03-28 + AFDParams[I].Value := fv.AsVariant; + end + else + begin + AFDParams[I].Clear; + end; + end; + finally + Map.Free; + end +end; + +class function Mapper.InternalExecuteFDQuery(AQuery: TFDQuery; AObject: TObject; + WithResult: boolean): Int64; +begin + ObjectToFDParameters(AQuery.Params, AObject); + Result := 0; + if WithResult then + AQuery.Open + else + begin + AQuery.ExecSQL; + Result := AQuery.RowsAffected; + end; +end; + +class function Mapper.ExecuteFDQueryNoResult(AQuery: TFDQuery; AObject: TObject): Int64; +begin + Result := InternalExecuteFDQuery(AQuery, AObject, false); +end; + +class procedure Mapper.ExecuteFDQuery(AQuery: TFDQuery; AObject: TObject); +begin + InternalExecuteFDQuery(AQuery, AObject, True); +end; +{$ENDIF} +{$IF CompilerVersion <= 25} + + +class function Mapper.ExecuteSQLQueryNoResult(AQuery: TSQLQuery; AObject: TObject): Int64; +begin + Result := InternalExecuteSQLQuery(AQuery, AObject, false); +end; + +class procedure Mapper.ExecuteSQLQuery(AQuery: TSQLQuery; AObject: TObject); +begin + InternalExecuteSQLQuery(AQuery, AObject, True); +end; + +class function Mapper.ExecuteSQLQueryAsObjectList(AQuery: TSQLQuery; AObject: TObject) + : TObjectList; +begin + ExecuteSQLQuery(AQuery, AObject); + Result := TObjectList.Create(True); + DataSetToObjectList(AQuery, Result); +end; +{$IFEND} +{ MappedField } + +constructor MapperColumnAttribute.Create(AFieldName: string; AIsPK: boolean); +begin + inherited Create; + FFieldName := AFieldName; + FIsPK := AIsPK; +end; + +procedure MapperColumnAttribute.SetFieldName(const Value: string); +begin + FFieldName := Value; +end; + +procedure MapperColumnAttribute.SetIsPK(const Value: boolean); +begin + FIsPK := Value; +end; +{ GridColumnProps } + +constructor GridColumnProps.Create(ACaption: string; AAlign: TGridColumnAlign; AWidth: Integer); +begin + inherited Create; + FCaption := ACaption; + FAlign := AAlign; + +{$IF CompilerVersion >= 23.0} + FWidth := System.Math.Max(AWidth, 50); + +{$ELSE} + FWidth := Math.Max(AWidth, 50); + +{$IFEND} +end; + +function GridColumnProps.GetAlignAsString: string; +begin + case FAlign of + caLeft: + Result := 'left'; + caCenter: + Result := 'center'; + caRight: + Result := 'right'; + end; +end; + +{ JSONSer } + +constructor MapperJSONSer.Create(AName: string); +begin + inherited Create; + FName := AName; +end; + +function MapperJSONSer.GetName: string; +begin + Result := FName; +end; + +{ JSONNaming } + +constructor MapperJSONNaming.Create(JSONKeyCase: TJSONNameCase); +begin + inherited Create; + FJSONKeyCase := JSONKeyCase; +end; + +function MapperJSONNaming.GetKeyCase: TJSONNameCase; +begin + Result := FJSONKeyCase; +end; + +{ StringValueAttribute } + +constructor StringValueAttribute.Create(Value: string); +begin + inherited Create; + FValue := Value; +end; + +procedure StringValueAttribute.SetValue(const Value: string); +begin + FValue := Value; +end; + +{ ItemsClassType } + +constructor MapperItemsClassType.Create(Value: TClass); +begin + inherited Create; + FValue := Value; +end; + +procedure MapperItemsClassType.SetValue(const Value: TClass); +begin + FValue := Value; +end; + +{ TDataSetHelper } + +function TDataSetHelper.AsJSONArray: TJSONArray; +var + JArr: TJSONArray; +begin + + JArr := TJSONArray.Create; + try + if not Eof then + Mapper.DataSetToJSONArray(Self, JArr, false); + Result := JArr; + except + FreeAndNil(JArr); + raise; + end; +end; + +function TDataSetHelper.AsJSONArrayString: string; +var + Arr: TJSONArray; +begin + Arr := AsJSONArray; + try +{$IF CompilerVersion >= 28} + Result := Arr.ToJSON; +{$ELSE} + Result := Arr.ToString; +{$ENDIF} + finally + Arr.Free; + end; +end; + +function TDataSetHelper.AsJSONObject(AReturnNilIfEOF: boolean; AFieldNamePolicy: TFieldNamePolicy) + : TJSONObject; +var + JObj: TJSONObject; +begin + JObj := TJSONObject.Create; + try + Mapper.DataSetToJSONObject(Self, JObj, false); + if AReturnNilIfEOF and (JObj.Size = 0) then + FreeAndNil(JObj); + Result := JObj; + except + FreeAndNil(JObj); + raise; + end; +end; + +function TDataSetHelper.AsJSONObjectString(AReturnEmptyStringIfEOF: boolean): string; +var + JObj: TJSONObject; +begin + JObj := AsJSONObject(True); + if not Assigned(JObj) then + begin + if AReturnEmptyStringIfEOF then + Result := '' + else + Result := '{}'; + end + else + try +{$IF CompilerVersion >= 28} + Result := JObj.ToJSON; +{$ELSE} + Result := JObj.ToString +{$ENDIF} + finally + JObj.Free; + end; +end; + +function TDataSetHelper.AsObject(CloseAfterScroll: boolean): T; +var + Obj: T; +begin + if not Self.Eof then + begin + Obj := T.Create; + try + Mapper.DataSetToObject(Self, Obj); + Result := Obj; + except + FreeAndNil(Obj); + raise; + end; + end + else + Result := nil; +end; + +function TDataSetHelper.AsObjectList(CloseAfterScroll: boolean): TObjectList; +var + Objs: TObjectList; +begin + Objs := TObjectList.Create(True); + try + Mapper.DataSetToObjectList(Self, Objs, CloseAfterScroll); + Result := Objs; + except + FreeAndNil(Objs); + raise; + end; +end; + +procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray; + AFieldNamePolicy: TFieldNamePolicy); +begin + Self.DisableControls; + try + Mapper.JSONArrayToDataSet(AJSONArray, Self, TArray.Create(), false, AFieldNamePolicy); + finally + Self.EnableControls; + end; +end; + +procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray; AIgnoredFields: TArray); +begin + Self.DisableControls; + try + Mapper.JSONArrayToDataSet(AJSONArray, Self, AIgnoredFields, false); + finally + Self.EnableControls; + end; +end; + +procedure TDataSetHelper.LoadFromJSONArrayString(AJSONArrayString: string); +begin + AppendFromJSONArrayString(AJSONArrayString); +end; + +procedure TDataSetHelper.AppendFromJSONArrayString(AJSONArrayString: string; + AIgnoredFields: TArray); +var + JV: TJSONValue; +begin + JV := TJSONObject.ParseJSONValue(AJSONArrayString); + try + if JV is TJSONArray then + LoadFromJSONArray(TJSONArray(JV), AIgnoredFields) + else + raise EMapperException.Create('Expected JSONArray in LoadFromJSONArrayString'); + finally + JV.Free; + end; +end; + +procedure TDataSetHelper.AppendFromJSONArrayString(AJSONArrayString: string); +begin + AppendFromJSONArrayString(AJSONArrayString, TArray.Create()); +end; + +procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject; + AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy); +begin + Mapper.JSONObjectToDataSet(AJSONObject, Self, AIgnoredFields, false, AFieldNamePolicy); +end; + +procedure TDataSetHelper.LoadFromJSONObjectString(AJSONObjectString: string; + AIgnoredFields: TArray); +var + JV: TJSONValue; +begin + JV := TJSONObject.ParseJSONValue(AJSONObjectString); + try + if JV is TJSONObject then + LoadFromJSONObject(TJSONObject(JV), AIgnoredFields) + else + raise EMapperException.Create('Extected JSONObject in LoadFromJSONObjectString'); + finally + JV.Free; + end; +end; + +procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject; + AFieldNamePolicy: TFieldNamePolicy); +begin + LoadFromJSONObject(AJSONObject, TArray.Create()); +end; + +procedure TDataSetHelper.LoadFromJSONObjectString(AJSONObjectString: string); +begin + LoadFromJSONObjectString(AJSONObjectString, TArray.Create()); +end; + +{ MapperSerializeAsString } + +constructor MapperSerializeAsString.Create(AEncoding: string); +begin + inherited Create; + if AEncoding.IsEmpty then + FEncoding := DefaultEncoding + else + FEncoding := AEncoding; +end; + +procedure MapperSerializeAsString.SetEncoding(const Value: string); +begin + FEncoding := Value; +end; + +end. diff --git a/src/RTTIUtilsU.pas b/src/RTTIUtilsU.pas new file mode 100644 index 0000000..c375d70 --- /dev/null +++ b/src/RTTIUtilsU.pas @@ -0,0 +1,850 @@ +// *************************************************************************** +// +// Delphi MVC Framework +// +// Copyright (c) 2010-2016 Daniele Teti and the DMVCFramework Team +// +// https://github.com/danieleteti/delphimvcframework +// +// *************************************************************************** +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// *************************************************************************** + +unit RTTIUtilsU; + +interface + +uses + RTTI, + DB, + Generics.Collections, + System.SysUtils; + +type + TRTTIUtils = class sealed + public + class var ctx: TRttiContext; + class var TValueToStringFormatSettings: TFormatSettings; + + public + class function MethodCall(AObject: TObject; AMethodName: string; AParameters: array of TValue; + RaiseExceptionIfNotFound: boolean = true): TValue; + class function GetMethod(AObject: TObject; AMethodName: string): TRttiMethod; + class procedure SetProperty(Obj: TObject; const PropertyName: string; const Value: TValue); overload; static; + class function GetFieldType(AProp: TRttiProperty): string; + class function GetPropertyType(AObject: TObject; APropertyName: string): string; + class procedure ObjectToDataSet(Obj: TObject; Field: TField; var Value: Variant); + class function ExistsProperty(AObject: TObject; const APropertyName: string; out AProperty: TRttiProperty): boolean; + class procedure DatasetToObject(Dataset: TDataset; Obj: TObject); + class function GetProperty(Obj: TObject; const PropertyName: string): TValue; + class function GetPropertyAsString(Obj: TObject; const PropertyName: string): string; overload; + + class function GetPropertyAsString(Obj: TObject; AProperty: TRttiProperty): string; overload; + class function GetField(Obj: TObject; const PropertyName: string): TValue; overload; + class procedure SetField(Obj: TObject; const PropertyName: string; const Value: TValue); overload; + class function Clone(Obj: TObject): TObject; static; + class procedure CopyObject(SourceObj, TargetObj: TObject); static; +{$IF CompilerVersion >= 24.0} // not supported in xe3 + class procedure CopyObjectAS(SourceObj, TargetObj: TObject); static; +{$IFEND} + class function CreateObject(ARttiType: TRttiType): TObject; overload; static; + class function CreateObject(AQualifiedClassName: string): TObject; overload; static; + class function GetAttribute(const Obj: TRttiObject): T; overload; + class function GetAttribute(const Obj: TRttiType): T; overload; + + class function HasAttribute(const Obj: TRttiObject): boolean; overload; + class function HasAttribute(const Obj: TRttiObject; out AAttribute: T): boolean; overload; + class function HasAttribute(aObj: TObject; out AAttribute: T): boolean; overload; + class function HasAttribute(ARTTIMember: TRttiMember; out AAttribute: T): boolean; overload; + class function HasAttribute(ARTTIMember: TRttiType; out AAttribute: T): boolean; overload; + + class function TValueAsString(const Value: TValue; const PropertyType, CustomFormat: string): string; + class function EqualValues(source, destination: TValue): boolean; + class function FindByProperty(List: TObjectList; PropertyName: string; PropertyValue: TValue): T; + class procedure ForEachProperty(Clazz: TClass; Proc: TProc); + class function HasStringValueAttribute(ARTTIMember: TRttiMember; out Value: string): boolean; + class function BuildClass(AQualifiedName: string; Params: array of TValue): TObject; + class function FindType(QualifiedName: string): TRttiType; + class function GetGUID: TGUID; + + end; + +function FieldFor(const PropertyName: string): string; inline; + +implementation + +uses + Classes, + TypInfo, + ObjectsMappers, + DuckListU; + +class function TRTTIUtils.MethodCall(AObject: TObject; AMethodName: string; AParameters: array of TValue; + RaiseExceptionIfNotFound: boolean): TValue; +var + m: TRttiMethod; + T: TRttiType; + Found: boolean; + ParLen: Integer; + MethodParamsLen: Integer; +begin + Found := False; + T := ctx.GetType(AObject.ClassInfo); + ParLen := Length(AParameters); + m := nil; + for m in T.GetMethods do + begin + MethodParamsLen := Length(m.GetParameters); + if m.Name.Equals(AMethodName) and (MethodParamsLen = ParLen) then + begin + Found := true; + Break; + end; + end; + + if Found then + Result := m.Invoke(AObject, AParameters) + else if RaiseExceptionIfNotFound then + raise Exception.CreateFmt('Cannot find compatible method "%s" in the object', [AMethodName]); +end; + +function FieldFor(const PropertyName: string): string; inline; +begin + Result := 'F' + PropertyName; +end; + +class function TRTTIUtils.GetAttribute(const Obj: TRttiObject): T; +var + Attr: TCustomAttribute; +begin + Result := nil; + for Attr in Obj.GetAttributes do + begin + if Attr.ClassType.InheritsFrom(T) then + Exit(T(Attr)); + end; +end; + +class function TRTTIUtils.GetAttribute(const Obj: TRttiType): T; +var + Attr: TCustomAttribute; +begin + Result := nil; + for Attr in Obj.GetAttributes do + begin + if Attr.ClassType.InheritsFrom(T) then + Exit(T(Attr)); + end; +end; + +class function TRTTIUtils.GetField(Obj: TObject; const PropertyName: string): TValue; +var + Field: TRttiField; + Prop: TRttiProperty; + ARttiType: TRttiType; +begin + ARttiType := ctx.GetType(Obj.ClassType); + if not Assigned(ARttiType) then + raise Exception.CreateFmt('Cannot get RTTI for type [%s]', [ARttiType.ToString]); + Field := ARttiType.GetField(FieldFor(PropertyName)); + if Assigned(Field) then + Result := Field.GetValue(Obj) + else + begin + Prop := ARttiType.GetProperty(PropertyName); + if not Assigned(Prop) then + raise Exception.CreateFmt('Cannot get RTTI for property [%s.%s]', [ARttiType.ToString, PropertyName]); + Result := Prop.GetValue(Obj); + end; +end; + +class function TRTTIUtils.GetProperty(Obj: TObject; const PropertyName: string): TValue; +var + Prop: TRttiProperty; + ARttiType: TRttiType; +begin + ARttiType := ctx.GetType(Obj.ClassType); + if not Assigned(ARttiType) then + raise Exception.CreateFmt('Cannot get RTTI for type [%s]', [ARttiType.ToString]); + Prop := ARttiType.GetProperty(PropertyName); + if not Assigned(Prop) then + raise Exception.CreateFmt('Cannot get RTTI for property [%s.%s]', [ARttiType.ToString, PropertyName]); + if Prop.IsReadable then + Result := Prop.GetValue(Obj) + else + raise Exception.CreateFmt('Property is not readable [%s.%s]', [ARttiType.ToString, PropertyName]); +end; + +class function TRTTIUtils.GetPropertyAsString(Obj: TObject; AProperty: TRttiProperty): string; +var + P: TValue; + FT: string; + CustomFormat: string; +begin + if AProperty.IsReadable then + begin + P := AProperty.GetValue(Obj); + FT := GetFieldType(AProperty); + HasStringValueAttribute(AProperty, CustomFormat); + Result := TValueAsString(P, FT, CustomFormat); + end + else + Result := ''; +end; + +class function TRTTIUtils.GetPropertyAsString(Obj: TObject; const PropertyName: string): string; +var + Prop: TRttiProperty; +begin + Prop := ctx.GetType(Obj.ClassType).GetProperty(PropertyName); + if Assigned(Prop) then + Result := GetPropertyAsString(Obj, Prop) + else + Result := ''; +end; + +class function TRTTIUtils.GetPropertyType(AObject: TObject; APropertyName: string): string; +begin + Result := GetFieldType(ctx.GetType(AObject.ClassInfo).GetProperty(APropertyName)); +end; + +class function TRTTIUtils.HasAttribute(const Obj: TRttiObject): boolean; +begin + Result := Assigned(GetAttribute(Obj)); +end; + +class function TRTTIUtils.HasAttribute(ARTTIMember: TRttiMember; out AAttribute: T): boolean; +var + attrs: TArray; + Attr: TCustomAttribute; +begin + AAttribute := nil; + Result := False; + attrs := ARTTIMember.GetAttributes; + for Attr in attrs do + if Attr is T then + begin + AAttribute := T(Attr); + Exit(true); + end; +end; + +class function TRTTIUtils.HasAttribute(ARTTIMember: TRttiType; out AAttribute: T): boolean; +var + attrs: TArray; + Attr: TCustomAttribute; +begin + AAttribute := nil; + Result := False; + attrs := ARTTIMember.GetAttributes; + for Attr in attrs do + if Attr is T then + begin + AAttribute := T(Attr); + Exit(true); + end; + +end; + +class function TRTTIUtils.HasAttribute(const Obj: TRttiObject; out AAttribute: T): boolean; +begin + AAttribute := GetAttribute(Obj); + Result := Assigned(AAttribute); +end; + +class function TRTTIUtils.HasStringValueAttribute(ARTTIMember: TRttiMember; out Value: string): boolean; +var + Attr: T; // StringValueAttribute; +begin + Result := HasAttribute(ARTTIMember, Attr); + if Result then + Value := StringValueAttribute(Attr).Value + else + Value := ''; +end; + +class procedure TRTTIUtils.SetField(Obj: TObject; const PropertyName: string; const Value: TValue); +var + Field: TRttiField; + Prop: TRttiProperty; + ARttiType: TRttiType; +begin + ARttiType := ctx.GetType(Obj.ClassType); + if not Assigned(ARttiType) then + raise Exception.CreateFmt('Cannot get RTTI for type [%s]', [ARttiType.ToString]); + Field := ARttiType.GetField(FieldFor(PropertyName)); + if Assigned(Field) then + Field.SetValue(Obj, Value) + else + begin + Prop := ARttiType.GetProperty(PropertyName); + if Assigned(Prop) then + begin + if Prop.IsWritable then + Prop.SetValue(Obj, Value) + end + else + raise Exception.CreateFmt('Cannot get RTTI for field or property [%s.%s]', [ARttiType.ToString, PropertyName]); + end; +end; + +class procedure TRTTIUtils.SetProperty(Obj: TObject; const PropertyName: string; const Value: TValue); +var + Prop: TRttiProperty; + ARttiType: TRttiType; +begin + ARttiType := ctx.GetType(Obj.ClassType); + if not Assigned(ARttiType) then + raise Exception.CreateFmt('Cannot get RTTI for type [%s]', [ARttiType.ToString]); + Prop := ARttiType.GetProperty(PropertyName); + if not Assigned(Prop) then + raise Exception.CreateFmt('Cannot get RTTI for property [%s.%s]', [ARttiType.ToString, PropertyName]); + if Prop.IsWritable then + Prop.SetValue(Obj, Value) + else + raise Exception.CreateFmt('Property is not writeable [%s.%s]', [ARttiType.ToString, PropertyName]); +end; + +class function TRTTIUtils.TValueAsString(const Value: TValue; const PropertyType, CustomFormat: string): string; +begin + case Value.Kind of + tkUnknown: + Result := ''; + tkInteger: + Result := IntToStr(Value.AsInteger); + tkChar: + Result := Value.AsString; + tkEnumeration: + if PropertyType = 'boolean' then + Result := BoolToStr(Value.AsBoolean, true) + else + Result := '(enumeration)'; + tkFloat: + begin + if PropertyType = 'datetime' then + begin + if CustomFormat = '' then + Exit(DateTimeToStr(Value.AsExtended)) + else + Exit(FormatDateTime(CustomFormat, Value.AsExtended)) + end + else if PropertyType = 'date' then + begin + if CustomFormat = '' then + Exit(DateToStr(Value.AsExtended)) + else + Exit(FormatDateTime(CustomFormat, Trunc(Value.AsExtended))) + end + else if PropertyType = 'time' then + begin + if CustomFormat = '' then + Exit(TimeToStr(Value.AsExtended)) + else + Exit(FormatDateTime(CustomFormat, Frac(Value.AsExtended))) + end; + if CustomFormat.IsEmpty then + Result := FloatToStr(Value.AsExtended) + else + Result := FormatFloat(CustomFormat, Value.AsExtended); + end; + tkString: + Result := Value.AsString; + tkSet: + ; + tkClass: + Result := Value.AsObject.QualifiedClassName; + tkMethod: + ; + tkWChar: + Result := Value.AsString; + + tkLString: + Result := Value.AsString; + + tkWString: + Result := Value.AsString; + + tkVariant: + Result := string(Value.AsVariant); + + tkArray: + Result := '(array)'; + tkRecord: + Result := '(record)'; + tkInterface: + Result := '(interface)'; + + tkInt64: + Result := IntToStr(Value.AsInt64); + + tkDynArray: + Result := '(array)'; + + tkUString: + Result := Value.AsString; + tkClassRef: + Result := '(classref)'; + + tkPointer: + Result := '(pointer)'; + + tkProcedure: + Result := '(procedure)'; + end; +end; + +class function TRTTIUtils.GetFieldType(AProp: TRttiProperty): string; +var + _PropInfo: PTypeInfo; +begin + _PropInfo := AProp.PropertyType.Handle; + if _PropInfo.Kind in [tkString, tkWString, tkChar, tkWChar, tkLString, tkUString] then + Result := 'string' + else if _PropInfo.Kind in [tkInteger, tkInt64] then + Result := 'integer' + else if _PropInfo = TypeInfo(TDate) then + Result := 'date' + else if _PropInfo = TypeInfo(TDateTime) then + Result := 'datetime' + else if _PropInfo = TypeInfo(Currency) then + Result := 'decimal' + else if _PropInfo = TypeInfo(TTime) then + begin + Result := 'time' + end + else if _PropInfo.Kind = tkFloat then + begin + Result := 'float' + end + else if (_PropInfo.Kind = tkEnumeration) { and (_PropInfo.Name = 'Boolean') } then + Result := 'boolean' + else if AProp.PropertyType.IsInstance and AProp.PropertyType.AsInstance.MetaclassType.InheritsFrom(TStream) then + Result := 'blob' + else + Result := EmptyStr; +end; + +class function TRTTIUtils.GetGUID: TGUID; +var + Tp: TRttiType; +begin + Tp := ctx.GetType(TypeInfo(T)); + if not (Tp.TypeKind = tkInterface) then + raise Exception.Create('Type is no interface'); + Result := TRttiInterfaceType(Tp).GUID; +end; + +class function TRTTIUtils.GetMethod(AObject: TObject; AMethodName: string): TRttiMethod; +var + T: TRttiType; +begin + T := ctx.GetType(AObject.ClassInfo); + Result := T.GetMethod(AMethodName); +end; + +class procedure TRTTIUtils.ObjectToDataSet(Obj: TObject; Field: TField; var Value: Variant); +begin + Value := GetProperty(Obj, Field.FieldName).AsVariant; +end; + +class procedure TRTTIUtils.DatasetToObject(Dataset: TDataset; Obj: TObject); +var + ARttiType: TRttiType; + props: TArray; + Prop: TRttiProperty; + f: TField; +begin + ARttiType := ctx.GetType(Obj.ClassType); + props := ARttiType.GetProperties; + for Prop in props do + if not SameText(Prop.Name, 'ID') then + begin + f := Dataset.FindField(Prop.Name); + if Assigned(f) and not f.ReadOnly then + begin + if f is TIntegerField then + SetProperty(Obj, Prop.Name, TIntegerField(f).Value) + else + SetProperty(Obj, Prop.Name, TValue.From(f.Value)) + end; + end; +end; + +class function TRTTIUtils.EqualValues(source, destination: TValue): boolean; +begin + // Really UniCodeCompareStr (Annoying VCL Name for backwards compatablity) + Result := AnsiCompareStr(source.ToString, destination.ToString) = 0; +end; + +class function TRTTIUtils.ExistsProperty(AObject: TObject; const APropertyName: string; out AProperty: TRttiProperty): boolean; +begin + AProperty := ctx.GetType(AObject.ClassInfo).GetProperty(APropertyName); + Result := Assigned(AProperty); +end; + +class function TRTTIUtils.FindByProperty(List: TObjectList; PropertyName: string; PropertyValue: TValue): T; +var + elem: T; + V: TValue; + Found: boolean; +begin + Found := False; + for elem in List do + begin + V := GetProperty(elem, PropertyName); + case V.Kind of + tkInteger: + Found := V.AsInteger = PropertyValue.AsInteger; + tkFloat: + Found := abs(V.AsExtended - PropertyValue.AsExtended) < 0.001; + tkString, tkLString, tkWString, tkUString: + Found := V.AsString = PropertyValue.AsString; + tkInt64: + Found := V.AsInt64 = PropertyValue.AsInt64; + else + raise Exception.Create('Property type not supported'); + end; + if Found then + Exit(elem); + end; + Result := nil; +end; + +class function TRTTIUtils.FindType(QualifiedName: string): TRttiType; +begin + Result := ctx.FindType(QualifiedName); +end; + +class procedure TRTTIUtils.ForEachProperty(Clazz: TClass; Proc: TProc); +var + _rtti: TRttiType; + P: TRttiProperty; +begin + _rtti := ctx.GetType(Clazz); + if Assigned(_rtti) then + begin + for P in _rtti.GetProperties do + Proc(P); + end; +end; + +class procedure TRTTIUtils.CopyObject(SourceObj, TargetObj: TObject); +var + _ARttiType: TRttiType; + Field: TRttiField; + master, cloned: TObject; + Src: TObject; + sourceStream: TStream; + SavedPosition: Int64; + targetStream: TStream; + targetCollection: IWrappedList; + sourceCollection: IWrappedList; + I: Integer; + sourceObject: TObject; + targetObject: TObject; + Tar: TObject; +begin + if not Assigned(TargetObj) then + Exit; + + _ARttiType := ctx.GetType(SourceObj.ClassType); + cloned := TargetObj; + master := SourceObj; + for Field in _ARttiType.GetFields do + begin + if not Field.FieldType.IsInstance then + Field.SetValue(cloned, Field.GetValue(master)) + else + begin + Src := Field.GetValue(SourceObj).AsObject; + if Src is TStream then + begin + sourceStream := TStream(Src); + SavedPosition := sourceStream.Position; + sourceStream.Position := 0; + if Field.GetValue(cloned).IsEmpty then + begin + targetStream := TMemoryStream.Create; + Field.SetValue(cloned, targetStream); + end + else + targetStream := Field.GetValue(cloned).AsObject as TStream; + targetStream.Position := 0; + targetStream.CopyFrom(sourceStream, sourceStream.Size); + targetStream.Position := SavedPosition; + sourceStream.Position := SavedPosition; + end + else if TDuckTypedList.CanBeWrappedAsList(Src) then + begin + sourceCollection := WrapAsList(Src); + Tar := Field.GetValue(cloned).AsObject; + if Assigned(Tar) then + begin + targetCollection := WrapAsList(Tar); + targetCollection.Clear; + for I := 0 to sourceCollection.Count - 1 do + targetCollection.Add(TRTTIUtils.Clone(sourceCollection.GetItem(I))); + end; + end + else + begin + sourceObject := Src; + + if Field.GetValue(cloned).IsEmpty then + begin + targetObject := TRTTIUtils.Clone(sourceObject); + Field.SetValue(cloned, targetObject); + end + else + begin + targetObject := Field.GetValue(cloned).AsObject; + TRTTIUtils.CopyObject(sourceObject, targetObject); + end; + end; + end; + end; +end; + +{$IF CompilerVersion >= 24.0} + +class procedure TRTTIUtils.CopyObjectAS(SourceObj, TargetObj: TObject); +var + _ARttiType: TRttiType; + _ARttiTypeTarget: TRttiType; + Field, FieldDest: TRttiField; + master, cloned: TObject; + Src: TObject; + sourceStream: TStream; + SavedPosition: Int64; + targetStream: TStream; + targetCollection: IWrappedList; + sourceCollection: IWrappedList; + I: Integer; + sourceObject: TObject; + targetObject: TObject; + Tar: TObject; +begin + if not Assigned(TargetObj) then + Exit; + + _ARttiType := ctx.GetType(SourceObj.ClassType); + _ARttiTypeTarget := ctx.GetType(TargetObj.ClassType); + + cloned := TargetObj; + master := SourceObj; + for Field in _ARttiType.GetFields do + begin + FieldDest := _ARttiTypeTarget.GetField(Field.Name); + if not Assigned(FieldDest) then + continue; + if not Field.FieldType.IsInstance then + begin + FieldDest.SetValue(cloned, Field.GetValue(master)); + end + else + begin + Src := Field.GetValue(SourceObj).AsObject; + if not Assigned(Src) then + begin + FieldDest.SetValue(cloned, Src); + + end + else if Src is TStream then + begin + sourceStream := TStream(Src); + SavedPosition := sourceStream.Position; + sourceStream.Position := 0; + if FieldDest.GetValue(cloned).IsEmpty then + begin + targetStream := TMemoryStream.Create; + FieldDest.SetValue(cloned, targetStream); + end + else + targetStream := FieldDest.GetValue(cloned).AsObject as TStream; + targetStream.Position := 0; + targetStream.CopyFrom(sourceStream, sourceStream.Size); + targetStream.Position := SavedPosition; + sourceStream.Position := SavedPosition; + end + else if TDuckTypedList.CanBeWrappedAsList(Src) then + begin + sourceCollection := WrapAsList(Src); + Tar := FieldDest.GetValue(cloned).AsObject; + if Assigned(Tar) then + begin + targetCollection := WrapAsList(Tar); + targetCollection.Clear; + for I := 0 to sourceCollection.Count - 1 do + targetCollection.Add(TRTTIUtils.Clone(sourceCollection.GetItem(I))); + end; + end + else + begin + sourceObject := Src; + + if FieldDest.GetValue(cloned).IsEmpty then + begin + targetObject := TRTTIUtils.Clone(sourceObject); + FieldDest.SetValue(cloned, targetObject); + end + else + begin + targetObject := FieldDest.GetValue(cloned).AsObject; + TRTTIUtils.CopyObject(sourceObject, targetObject); + end; + end; + end; + end; +end; +{$IFEND} + +class function TRTTIUtils.CreateObject(AQualifiedClassName: string): TObject; +var + rttitype: TRttiType; +begin + rttitype := ctx.FindType(AQualifiedClassName); + if Assigned(rttitype) then + Result := CreateObject(rttitype) + else + raise Exception.Create('Cannot find RTTI for ' + AQualifiedClassName + '. Hint: Is the specified classtype linked in the module?'); +end; + +class function TRTTIUtils.CreateObject(ARttiType: TRttiType): TObject; +var + Method: TRttiMethod; + metaClass: TClass; +begin + { First solution, clear and slow } + metaClass := nil; + Method := nil; + for Method in ARttiType.GetMethods do + if Method.HasExtendedInfo and Method.IsConstructor then + if Length(Method.GetParameters) = 0 then + begin + metaClass := ARttiType.AsInstance.MetaclassType; + Break; + end; + if Assigned(metaClass) then + Result := Method.Invoke(metaClass, []).AsObject + else + raise Exception.Create('Cannot find a propert constructor for ' + ARttiType.ToString); + + { Second solution, dirty and fast } + // Result := TObject(ARttiType.GetMethod('Create') + // .Invoke(ARttiType.AsInstance.MetaclassType, []).AsObject); +end; + +class function TRTTIUtils.BuildClass(AQualifiedName: string; Params: array of TValue): TObject; +var + T: TRttiType; + V: TValue; +begin + + T := FindType(AQualifiedName); + V := T.GetMethod('Create').Invoke(T.AsInstance.MetaclassType, Params); + Result := V.AsObject; +end; + +class function TRTTIUtils.Clone(Obj: TObject): TObject; +var + _ARttiType: TRttiType; + Field: TRttiField; + master, cloned: TObject; + Src: TObject; + sourceStream: TStream; + SavedPosition: Int64; + targetStream: TStream; + targetCollection: TObjectList; + sourceCollection: TObjectList; + I: Integer; + sourceObject: TObject; + targetObject: TObject; +begin + Result := nil; + if not Assigned(Obj) then + Exit; + + _ARttiType := ctx.GetType(Obj.ClassType); + cloned := CreateObject(_ARttiType); + master := Obj; + for Field in _ARttiType.GetFields do + begin + if not Field.FieldType.IsInstance then + Field.SetValue(cloned, Field.GetValue(master)) + else + begin + Src := Field.GetValue(Obj).AsObject; + if Src is TStream then + begin + sourceStream := TStream(Src); + SavedPosition := sourceStream.Position; + sourceStream.Position := 0; + if Field.GetValue(cloned).IsEmpty then + begin + targetStream := TMemoryStream.Create; + Field.SetValue(cloned, targetStream); + end + else + targetStream := Field.GetValue(cloned).AsObject as TStream; + targetStream.Position := 0; + targetStream.CopyFrom(sourceStream, sourceStream.Size); + targetStream.Position := SavedPosition; + sourceStream.Position := SavedPosition; + end + else if Src is TObjectList then + begin + sourceCollection := TObjectList(Src); + if Field.GetValue(cloned).IsEmpty then + begin + targetCollection := TObjectList.Create; + Field.SetValue(cloned, targetCollection); + end + else + targetCollection := Field.GetValue(cloned).AsObject as TObjectList; + for I := 0 to sourceCollection.Count - 1 do + begin + targetCollection.Add(TRTTIUtils.Clone(sourceCollection[I])); + end; + end + else + begin + sourceObject := Src; + + if Field.GetValue(cloned).IsEmpty then + begin + targetObject := TRTTIUtils.Clone(sourceObject); + Field.SetValue(cloned, targetObject); + end + else + begin + targetObject := Field.GetValue(cloned).AsObject; + TRTTIUtils.CopyObject(sourceObject, targetObject); + end; + Field.SetValue(cloned, targetObject); + end; + end; + + end; + Result := cloned; +end; + +{ TListDuckTyping } + +class function TRTTIUtils.HasAttribute(aObj: TObject; out AAttribute: T): boolean; +begin + Result := HasAttribute(ctx.GetType(aObj.ClassType), AAttribute) +end; + +end. diff --git a/src/Router4D.History.pas b/src/Router4D.History.pas new file mode 100644 index 0000000..044c648 --- /dev/null +++ b/src/Router4D.History.pas @@ -0,0 +1,216 @@ +unit Router4D.History; + +interface + +uses + Classes, + SysUtils, + FMX.Forms, + System.Generics.Collections, + Router4D.Interfaces, + FMX.Types, + Router4D.Props; + +type + TCachePersistent = record + FPatch : String; + FisVisible : Boolean; + FSBKey : String; + FPersistentClass : TPersistentClass; + end; + + TRouter4DHistory = class + private + FListCache : TObjectDictionary; + FListCacheContainer : TObjectDictionary; + FListCache2 : TDictionary; + FMainRouter : TFMXObject; + FIndexRouter : TFMXObject; + FInstanteObject : iRouter4DComponent; + procedure CreateInstancePersistent( aPath : String); + public + constructor Create; + destructor Destroy; override; + function MainRouter ( aValue : TFMXObject ) : TRouter4DHistory; overload; + function MainRouter : TFMXObject; overload; + function IndexRouter ( aValue : TFMXObject ) : TRouter4DHistory; overload; + function IndexRouter : TFMXObject; overload; + function AddHistory ( aKey : String; aObject : TObject ) : iRouter4DComponent; overload; + function AddHistory ( aKey : String; aObject : TPersistentClass ) : iRouter4DComponent; overload; + function AddHistory ( aKey : String; aObject : TPersistentClass; aSBKey : String; isVisible : Boolean ) : iRouter4DComponent; overload; + function AddHistoryConteiner ( aKey : String; aObject : TFMXObject) : TRouter4DHistory; overload; + function GetHistoryContainer ( aKey : String ) : TFMXObject; + function RemoveHistory ( aKey : String ) : TRouter4DHistory; + function GetHistory ( aKey : String ) : iRouter4DComponent; + function RoutersList : TDictionary; + function RoutersListPersistent : TDictionary; + function InstanteObject : iRouter4DComponent; + end; + +var + Router4DHistory : TRouter4DHistory; + +implementation + +{ TRouter4DHistory } + +function TRouter4DHistory.AddHistory( aKey : String; aObject : TObject ) : iRouter4DComponent; +var + mKey : String; +begin + if not Supports(aObject, iRouter4DComponent, Result) then + raise Exception.Create('Form not Implement iRouter4DelphiComponent Interface'); + + try GlobalEventBus.RegisterSubscriber(aObject); except end; + + if FListCache.Count > 25 then + for mKey in FListCache.Keys do + begin + FListCache.Remove(aKey); + exit; + end; + + FListCache.TryAdd(aKey, aObject); + +end; + +function TRouter4DHistory.AddHistory(aKey: String; + aObject: TPersistentClass): iRouter4DComponent; +var + CachePersistent : TCachePersistent; +begin + //if not Supports(aObject, iRouter4DComponent, Result) then + //raise Exception.Create('Form not Implement iRouter4DelphiComponent Interface'); + + CachePersistent.FPatch := aKey; + CachePersistent.FisVisible := True; + CachePersistent.FPersistentClass := aObject; + CachePersistent.FSBKey := 'SBIndex'; + + try FListCache2.Add(aKey, CachePersistent); except end; +end; + +function TRouter4DHistory.AddHistory(aKey: String; aObject: TPersistentClass; + aSBKey : String; isVisible: Boolean): iRouter4DComponent; +var + CachePersistent : TCachePersistent; +begin + CachePersistent.FPatch := aKey; + CachePersistent.FisVisible := isVisible; + CachePersistent.FPersistentClass := aObject; + CachePersistent.FSBKey := aSBKey; + + try FListCache2.TryAdd(aKey, CachePersistent); except end; +end; + +function TRouter4DHistory.AddHistoryConteiner( aKey : String; aObject : TFMXObject) : TRouter4DHistory; +var + auxObject : TFMXObject; +begin + Result := Self; + if not FListCacheContainer.TryGetValue(aKey, auxObject) then + FListCacheContainer.TryAdd(aKey, aObject); +end; + +constructor TRouter4DHistory.Create; +begin + FListCache := TObjectDictionary.Create; + FListCache2 := TDictionary.Create; + FListCacheContainer := TObjectDictionary.Create; +end; + +procedure TRouter4DHistory.CreateInstancePersistent( aPath : String); +var + aPersistentClass : TCachePersistent; +begin + if not FListCache2.TryGetValue(aPath, aPersistentClass) then + raise Exception.Create('Not Register Router ' + aPath); + + Self.AddHistory( + aPath, + TComponentClass( + FindClass( + aPersistentClass + .FPersistentClass + .ClassName + ) + ).Create(Application) + ); +end; + +destructor TRouter4DHistory.Destroy; +begin + FListCache.Free; + FListCache2.Free; + FListCacheContainer.Free; + inherited; +end; + +function TRouter4DHistory.GetHistory(aKey: String): iRouter4DComponent; +var + aObject : TObject; +begin + + if not FListCache.TryGetValue(aKey, aObject) then + Self.CreateInstancePersistent(aKey); + + if not Supports(FListCache.Items[aKey], iRouter4DComponent, Result) then + raise Exception.Create('Object not Implements Interface Component'); + + FInstanteObject := Result; +end; + +function TRouter4DHistory.GetHistoryContainer(aKey: String): TFMXObject; +begin + FListCacheContainer.TryGetValue(aKey, Result); +end; + +function TRouter4DHistory.IndexRouter: TFMXObject; +begin + Result := FIndexRouter; +end; + +function TRouter4DHistory.InstanteObject: iRouter4DComponent; +begin + Result := FInstanteObject; +end; + +function TRouter4DHistory.IndexRouter(aValue: TFMXObject): TRouter4DHistory; +begin + Result := Self; + FIndexRouter := aValue; +end; + +function TRouter4DHistory.MainRouter: TFMXObject; +begin + Result := FMainRouter; +end; + +function TRouter4DHistory.RemoveHistory(aKey: String): TRouter4DHistory; +begin + Result := Self; + FListCache.Remove(aKey); +end; + +function TRouter4DHistory.RoutersList: TDictionary; +begin + Result := FListCache; +end; + +function TRouter4DHistory.RoutersListPersistent: TDictionary; +begin + Result := FListCache2; +end; + +function TRouter4DHistory.MainRouter(aValue: TFMXObject): TRouter4DHistory; +begin + Result := Self; + FMainRouter := aValue; +end; + +initialization + Router4DHistory := TRouter4DHistory.Create; + +finalization + Router4DHistory.Free; +end. diff --git a/src/Router4D.Interfaces.pas b/src/Router4D.Interfaces.pas new file mode 100644 index 0000000..b105ba8 --- /dev/null +++ b/src/Router4D.Interfaces.pas @@ -0,0 +1,67 @@ +unit Router4D.Interfaces; + +interface + +uses + System.Classes, + System.Generics.Collections, + System.UITypes, + SysUtils, + FMX.Types, + Router4D.Props; + +type + + iRouter4D = interface + ['{56BF88E9-25AB-49C7-8CB2-F89C95F34816}'] + end; + + iRouter4DComponent = interface + ['{C605AEFB-36DC-4952-A3D9-BA372B998BC3}'] + function Render : TFMXObject; + procedure UnRender; + end; + + iRouter4DComponentProps = interface + ['{FAF5DD55-924F-4A8B-A436-208891FFE30A}'] + procedure Props ( aProps : TProps ); + end; + + iRouter4DLink = interface + ['{3C80F86A-D6B8-470C-A30E-A82E620F6F1D}'] + function &To ( aPatch : String; aComponent : TFMXObject ) : iRouter4DLink; overload; + function &To ( aPatch : String) : iRouter4DLink; overload; + function &To ( aPatch : String; aProps : TProps; aKey : String = '') : iRouter4DLink; overload; + function &To ( aPatch : String; aNameContainer : String) : iRouter4DLink; overload; + function Animation ( aAnimation : TProc ) : iRouter4DLink; + function IndexLink ( aPatch : String ) : iRouter4DLink; + end; + + iRouter4DRender = interface + ['{2BD026ED-3A92-44E9-8CD4-38E80CB2F000}'] + function SetElement ( aComponent : TFMXObject; aIndexComponent : TFMXObject = nil ) : iRouter4DRender; + end; + + iRouter4DSwitch = interface + ['{0E49AFE7-9329-4F0C-B289-A713FA3DFE45}'] + function Router(aPath : String; aRouter : TPersistentClass; aSidebarKey : String = 'SBIndex'; isVisible : Boolean = True) : iRouter4DSwitch; + function UnRouter(aPath : String) : iRouter4DSwitch; + end; + + iRouter4DSidebar = interface + ['{B4E8C229-A801-4FCA-AF7B-DEF8D0EE5DFE}'] + function Name ( aValue : String ) : iRouter4DSidebar; overload; + function MainContainer ( aValue : TFMXObject ) : iRouter4DSidebar; overload; + function Name : String; overload; + function MainContainer : TFMXObject; overload; + function FontSize ( aValue : Integer ) : iRouter4DSidebar; + function FontColor ( aValue : TAlphaColor ) : iRouter4DSidebar; + function ItemHeigth ( aValue : Integer ) : iRouter4DSidebar; + function LinkContainer ( aValue : TFMXObject ) : iRouter4DSidebar; + function RenderToListBox : iRouter4DSidebar; + function Animation ( aAnimation : TProc ) : iRouter4DSidebar; + end; + +implementation + +end. diff --git a/src/Router4D.Link.pas b/src/Router4D.Link.pas new file mode 100644 index 0000000..7a35f91 --- /dev/null +++ b/src/Router4D.Link.pas @@ -0,0 +1,147 @@ +unit Router4D.Link; + +interface + +uses + FMX.Types, + FMX.Layouts, + SysUtils, + Router4D.Interfaces, + Router4D.Props; + +type + TRouter4DLink = class(TInterfacedObject, iRouter4DLink) + private + FAnimation : TProc; + public + constructor Create; + destructor Destroy; override; + class function New : iRouter4DLink; + function Animation ( aAnimation : TProc ) : iRouter4DLink; + function &To ( aPatch : String; aComponent : TFMXObject ) : iRouter4DLink; overload; + function &To ( aPatch : String) : iRouter4DLink; overload; + function &To ( aPatch : String; aProps : TProps; aKey : String = '') : iRouter4DLink; overload; + function &To ( aPatch : String; aNameContainer : String) : iRouter4DLink; overload; + function IndexLink ( aPatch : String ) : iRouter4DLink; + end; + +implementation + +{ TRouter4DLink } + +uses Router4D.History; + +function TRouter4DLink.&To( aPatch : String; aComponent : TFMXObject ) : iRouter4DLink; +begin + Result := Self; + aComponent.RemoveObject(0); + Router4DHistory.InstanteObject.UnRender; + aComponent + .AddObject( + Router4DHistory + .GetHistory(aPatch) + .Render + ); +end; + +function TRouter4DLink.&To(aPatch, aNameContainer: String): iRouter4DLink; +var + aContainer : TFMXObject; +begin + Result := Self; + Router4DHistory.InstanteObject.UnRender; + aContainer := Router4DHistory.GetHistoryContainer(aNameContainer); + aContainer.RemoveObject(0); + + aContainer + .AddObject( + Router4DHistory + .GetHistory(aPatch) + .Render + ); + + if Assigned(FAnimation) then + FAnimation(aContainer); + +end; + +function TRouter4DLink.Animation(aAnimation: TProc): iRouter4DLink; +begin + Result := Self; + FAnimation := aAnimation; +end; + +constructor TRouter4DLink.Create; +begin + +end; + +destructor TRouter4DLink.Destroy; +begin + + inherited; +end; + +function TRouter4DLink.IndexLink(aPatch: String): iRouter4DLink; +begin + Result := Self; + Router4DHistory.IndexRouter.RemoveObject(0); + Router4DHistory.InstanteObject.UnRender; + Router4DHistory + .IndexRouter + .AddObject( + Router4DHistory + .GetHistory(aPatch) + .Render + ); + + if Assigned(FAnimation) then + FAnimation(Router4DHistory.IndexRouter); + +end; + +function TRouter4DLink.&To(aPatch: String) : iRouter4DLink; +begin + Result := Self; + Router4DHistory.MainRouter.RemoveObject(0); + Router4DHistory.InstanteObject.UnRender; + Router4DHistory + .MainRouter + .AddObject( + Router4DHistory + .GetHistory(aPatch) + .Render + ); + + if Assigned(FAnimation) then + FAnimation(Router4DHistory.MainRouter); + +end; + +function TRouter4DLink.&To(aPatch: String; aProps: TProps; aKey : String = '') : iRouter4DLink; +begin + Result := Self; + Router4DHistory.MainRouter.RemoveObject(0); + Router4DHistory.InstanteObject.UnRender; + Router4DHistory + .MainRouter + .AddObject( + Router4DHistory + .GetHistory(aPatch) + .Render + ); + + if Assigned(FAnimation) then + FAnimation(Router4DHistory.MainRouter); + + if aKey <> '' then aProps.Key(aKey); + + GlobalEventBus.Post(aProps); +end; + +class function TRouter4DLink.New: iRouter4DLink; +begin + Result := Self.Create; +end; + +end. diff --git a/src/Router4D.Props.pas b/src/Router4D.Props.pas new file mode 100644 index 0000000..ff69b6e --- /dev/null +++ b/src/Router4D.Props.pas @@ -0,0 +1,273 @@ +{ ******************************************************************************* + Copyright 2016-2019 Daniele Spinetti + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + ******************************************************************************** } + +unit Router4D.Props; + +interface + +uses + System.Classes, + System.SysUtils, + System.Rtti; + +type + + TThreadMode = (Posting, Main, Async, Background); + + TCloneEventCallback = function(const AObject: TObject): TObject of object; + TCloneEventMethod = TFunc; + + IEventBus = Interface + ['{7BDF4536-F2BA-4FBA-B186-09E1EE6C7E35}'] + procedure RegisterSubscriber(ASubscriber: TObject); + function IsRegistered(ASubscriber: TObject): Boolean; + procedure Unregister(ASubscriber: TObject); + procedure Post(AEvent: TObject; const AContext: String = ''; + AEventOwner: Boolean = true); + + procedure SetOnCloneEvent(const aCloneEvent: TCloneEventCallback); + procedure AddCustomClassCloning(const AQualifiedClassName: String; + const aCloneEvent: TCloneEventMethod); + procedure RemoveCustomClassCloning(const AQualifiedClassName: String); + + property OnCloneEvent: TCloneEventCallback write SetOnCloneEvent; + end; + + SubscribeAttribute = class(TCustomAttribute) + private + FContext: String; + FThreadMode: TThreadMode; + public + constructor Create(AThreadMode: TThreadMode = TThreadMode.Posting; + const AContext: String = ''); + property ThreadMode: TThreadMode read FThreadMode; + property Context: String read FContext; + end; + + TDEBEvent = class(TObject) + private + FDataOwner: Boolean; + FData: T; + procedure SetData(const Value: T); + procedure SetDataOwner(const Value: Boolean); + public + constructor Create; overload; + constructor Create(AData: T); overload; + destructor Destroy; override; + property DataOwner: Boolean read FDataOwner write SetDataOwner; + property Data: T read FData write SetData; + end; + + + TProps = class + private + FPropString: String; + FPropInteger: Integer; + FPropCurrency : Currency; + FPropDouble : Double; + FPropValue : TValue; + FPropObject : TObject; + FPropDateTime : TDateTime; + FKey : String; + public + constructor Create; + destructor Destroy; override; + function PropString ( aProp : String ) : TProps; overload; + function PropString : String; overload; + function PropInteger ( aProp : Integer ) : TProps; overload; + function PropInteger : Integer; overload; + function PropCurrency ( aProp : Currency ) : TProps; overload; + function PropCurrency : Currency; overload; + function PropDouble ( aProp : Double ) : TProps; overload; + function PropDouble : Double; overload; + function PropValue ( aProp : TValue ) : TProps; overload; + function PropValue : TValue; overload; + function PropObject ( aProp : TObject ) : TProps; overload; + function PropObject : TObject; overload; + function PropDateTime ( aProp : TDateTime ) : TProps; overload; + function PropDateTime : TDateTime; overload; + function Key ( aKey : String ) : TProps; overload; + function Key : String; overload; + end; + +function GlobalEventBus: IEventBus; + +implementation + +uses + EventBus.Core, RTTIUtilsU; + +var + FGlobalEventBus: IEventBus; + + { SubscribeAttribute } + +constructor SubscribeAttribute.Create(AThreadMode + : TThreadMode = TThreadMode.Posting; const AContext: String = ''); +begin + inherited Create; + FContext := AContext; + FThreadMode := AThreadMode; +end; + +{ TDEBSimpleEvent } + +constructor TDEBEvent.Create(AData: T); +begin + inherited Create; + DataOwner := true; + Data := AData; +end; + +constructor TDEBEvent.Create; +begin + inherited Create; +end; + +destructor TDEBEvent.Destroy; +var + LValue: TValue; +begin + LValue := TValue.From(Data); + if (LValue.IsObject) and DataOwner then + LValue.AsObject.Free; + inherited; +end; + +procedure TDEBEvent.SetData(const Value: T); +begin + FData := Value; +end; + +procedure TDEBEvent.SetDataOwner(const Value: Boolean); +begin + FDataOwner := Value; +end; + +function GlobalEventBus: IEventBus; +begin + if not Assigned(FGlobalEventBus) then + FGlobalEventBus := TEventBus.Create; + Result := FGlobalEventBus; +end; + +{ TProps } + +constructor TProps.Create; +begin + +end; + +destructor TProps.Destroy; +begin + + inherited; +end; + +function TProps.Key(aKey: String): TProps; +begin + Result := Self; + FKey := aKey; +end; + +function TProps.Key: String; +begin + Result := FKey; +end; + +function TProps.PropCurrency: Currency; +begin + Result := FPropCurrency; +end; + +function TProps.PropDateTime: TDateTime; +begin + Result := FPropDateTime; +end; + +function TProps.PropDateTime(aProp: TDateTime): TProps; +begin + Result := Self; + FPropDateTime := aProp; +end; + +function TProps.PropDouble: Double; +begin + Result := FPropDouble; +end; + +function TProps.PropDouble(aProp: Double): TProps; +begin + Result := Self; + FPropDouble := aProp; +end; + +function TProps.PropCurrency(aProp: Currency): TProps; +begin + Result := Self; + FPropCurrency := aProp; +end; + +function TProps.PropInteger: Integer; +begin + Result := FPropInteger; +end; + +function TProps.PropObject: TObject; +begin + Result := FPropObject; +end; + +function TProps.PropObject(aProp: TObject): TProps; +begin + Result := Self; + FPropObject := aProp; +end; + +function TProps.PropInteger(aProp: Integer): TProps; +begin + Result := Self; + FPropInteger := aProp; +end; + +function TProps.PropString(aProp: String): TProps; +begin + Result := Self; + FPropString := aProp; +end; + +function TProps.PropString: String; +begin + Result := FPropString; +end; + +function TProps.PropValue: TValue; +begin + Result := FPropValue; +end; + +function TProps.PropValue(aProp: TValue): TProps; +begin + Result := Self; + FPropValue := aProp; +end; + +initialization + GlobalEventBus; + +finalization + +end. diff --git a/src/Router4D.Render.pas b/src/Router4D.Render.pas new file mode 100644 index 0000000..24e6d4c --- /dev/null +++ b/src/Router4D.Render.pas @@ -0,0 +1,61 @@ +unit Router4D.Render; + +interface + +uses + Router4D.Interfaces, + FMX.Types; + +type + TRouter4DRender = class(TInterfacedObject, iRouter4DRender) + private + [weak] + FParent : iRouter4DComponent; + public + constructor Create(Parent : iRouter4DComponent); + destructor Destroy; override; + class function New(Parent : iRouter4DComponent) : iRouter4DRender; + function SetElement ( aComponent : TFMXObject; aIndexComponent : TFMXObject = nil ) : iRouter4DRender; + end; + +implementation + +uses + Router4D.History; + +{ TRouter4DelphiRender } + +constructor TRouter4DRender.Create(Parent: iRouter4DComponent); +begin + FParent := Parent; +end; + +destructor TRouter4DRender.Destroy; +begin + + inherited; +end; + +function TRouter4DRender.SetElement( aComponent : TFMXObject; aIndexComponent : TFMXObject = nil ) : iRouter4DRender; +begin + Result := Self; + Router4DHistory.MainRouter(aComponent); + + if aIndexComponent <> nil then + Router4DHistory.IndexRouter(aIndexComponent); + + if Assigned(FParent) then + begin + aComponent.RemoveObject(0); + aComponent.AddObject(FParent.Render); + end; + +end; + +class function TRouter4DRender.New( + Parent: iRouter4DComponent): iRouter4DRender; +begin + Result := Self.Create(Parent); +end; + +end. diff --git a/src/Router4D.Sidebar.pas b/src/Router4D.Sidebar.pas new file mode 100644 index 0000000..bc8a301 --- /dev/null +++ b/src/Router4D.Sidebar.pas @@ -0,0 +1,182 @@ +unit Router4D.Sidebar; + +interface + +uses + Classes, + SysUtils, + FMX.Types, + Router4D.Interfaces, + System.UITypes; + +type + TRouter4DSidebar = class(TInterfacedObject, iRouter4DSidebar) + private + FName : String; + FMainContainer : TFMXObject; + FFontSize : Integer; + FFontColor : TAlphaColor; + FItemHeigth : Integer; + FLinkContainer : TFMXObject; + FAnimation : TProc; + public + constructor Create; + destructor Destroy; override; + class function New : iRouter4DSidebar; + function Animation ( aAnimation : TProc ) : iRouter4DSidebar; + function Name ( aValue : String ) : iRouter4DSidebar; overload; + function MainContainer ( aValue : TFMXObject ) : iRouter4DSidebar; overload; + function Name : String; overload; + function MainContainer : TFMXObject; overload; + function FontSize ( aValue : Integer ) : iRouter4DSidebar; + function FontColor ( aValue : TAlphaColor ) : iRouter4DSidebar; + function ItemHeigth ( aValue : Integer ) : iRouter4DSidebar; + function LinkContainer ( aValue : TFMXObject ) : iRouter4DSidebar; + function RenderToListBox : iRouter4DSidebar; + end; + +implementation + +uses + FMX.ListBox, + FMX.SearchBox, + FMX.Layouts, + Router4D, + Router4D.History, + Router4D.Utils; + +{ TRouter4DSidebar } + +function TRouter4DSidebar.Animation( + aAnimation: TProc): iRouter4DSidebar; +begin + Result := Self; + FAnimation := aAnimation; +end; + +constructor TRouter4DSidebar.Create; +begin + FName := 'SBIndex'; + FLinkContainer := Router4DHistory.MainRouter; +end; + +destructor TRouter4DSidebar.Destroy; +begin + + inherited; +end; + +function TRouter4DSidebar.FontColor(aValue: TAlphaColor): iRouter4DSidebar; +begin + Result := Self; + FFontColor := aValue; +end; + +function TRouter4DSidebar.FontSize(aValue: Integer): iRouter4DSidebar; +begin + Result := Self; + FFontSize := aValue; +end; + +function TRouter4DSidebar.ItemHeigth(aValue: Integer): iRouter4DSidebar; +begin + Result := Self; + FItemHeigth := aValue; +end; + +function TRouter4DSidebar.LinkContainer(aValue: TFMXObject): iRouter4DSidebar; +begin + Result := Self; + FLinkContainer := aValue; +end; + +function TRouter4DSidebar.MainContainer(aValue: TFMXObject): iRouter4DSidebar; +begin + Result := Self; + FMainContainer := aValue; +end; + +function TRouter4DSidebar.MainContainer: TFMXObject; +begin + Result := FMainContainer; +end; + +function TRouter4DSidebar.Name(aValue: String): iRouter4DSidebar; +begin + Result := Self; + FName := aValue; +end; + +function TRouter4DSidebar.Name: String; +begin + Result := FName; +end; + +class function TRouter4DSidebar.New: iRouter4DSidebar; +begin + Result := Self.Create; +end; + +function TRouter4DSidebar.RenderToListBox: iRouter4DSidebar; +var + aListBox : TListBox; + aListBoxItem : TListBoxItem; + aItem : TCachePersistent; + AListBoxSearch : TSearchBox; +begin + aListBox := TListBox.Create(FMainContainer); + aListBox.Align := TAlignLayout.Client; + aListBox.ItemHeight := FItemHeigth; + aListBox.StyleLookup := 'transparentlistboxstyle'; + + aListBox.BeginUpdate; + + AListBoxSearch := TSearchBox.Create(aListBox); + AListBoxSearch.Height := FItemHeigth - 25; + aListBox.AddObject(AListBoxSearch); + + for aItem in Router4DHistory.RoutersListPersistent.Values do + begin + if AItem.FisVisible and (AItem.FSBKey = FName) then + begin + aListBoxItem := TListBoxItem.Create(aListBox); + aListBoxItem.Parent := aListBox; + aListBoxItem.StyledSettings:=[TStyledSetting.Other]; + aListBoxItem.TextSettings.Font.Size := FFontSize; + aListBoxItem.FontColor := FFontColor; + aListBoxItem.Text := aItem.FPatch; + aListBox.AddObject(aListBoxItem); + end; + end; + aListBox.EndUpdate; + + + Router4DHistory.AddHistoryConteiner(FName, FLinkContainer); + + aListBox.OnClick := + + TNotifyEventWrapper + .AnonProc2NotifyEvent( + aListBox, + procedure(Sender: TObject; Aux : String) + begin + TRouter4D + .Link + .Animation( + procedure ( aObject : TFMXObject ) + begin + TLayout(aObject).Opacity := 0; + TLayout(aObject).AnimateFloat('Opacity', 1, 0.2); + end) + .&To( + (Sender as TListBox).Items[(Sender as TListBox).ItemIndex], + Aux + ) + end, + FName + ); + + FMainContainer.AddObject(aListBox); +end; + +end. diff --git a/src/Router4D.Switch.pas b/src/Router4D.Switch.pas new file mode 100644 index 0000000..cfa3c93 --- /dev/null +++ b/src/Router4D.Switch.pas @@ -0,0 +1,73 @@ +unit Router4D.Switch; + +interface + +uses + Classes, + System.Generics.Collections, + Router4D.Interfaces, + Router4D.History; + +type + TRouter4DSwitch = class(TInterfacedObject, iRouter4DSwitch) + private + FSideBarList : TDictionary; + public + constructor Create; + destructor Destroy; override; + class function New : iRouter4DSwitch; + function Router(aPath : String; aRouter : TPersistentClass; aSidebarKey : String = 'SBIndex'; isVisible : Boolean = True) : iRouter4DSwitch; + function UnRouter(aPath : String) : iRouter4DSwitch; + function SidebarAdd ( aPatch : String; aSideBar : iRouter4DSidebar) : iRouter4DSwitch; + function SideBarList : TDictionary; + end; + +implementation + +{ TRouter4DSwitch } + +uses + Router4D.Utils; + +constructor TRouter4DSwitch.Create; +begin + FSideBarList := TDictionary.Create; +end; + +destructor TRouter4DSwitch.Destroy; +begin + FSideBarList.Free; + inherited; +end; + +class function TRouter4DSwitch.New: iRouter4DSwitch; +begin + Result := Self.Create; +end; + +function TRouter4DSwitch.Router(aPath : String; aRouter : TPersistentClass; aSidebarKey : String = 'SBIndex'; isVisible : Boolean = True) : iRouter4DSwitch; +begin + Result := Self; + RegisterClass(aRouter); + Router4DHistory.AddHistory(aPath, aRouter, aSidebarKey, isVisible); +end; + +function TRouter4DSwitch.SidebarAdd(aPatch: String; + aSideBar: iRouter4DSidebar): iRouter4DSwitch; +begin + Result := Self; + FSideBarList.Add(aPatch, aSideBar); +end; + +function TRouter4DSwitch.SideBarList: TDictionary; +begin + Result := FSideBarList; +end; + +function TRouter4DSwitch.UnRouter(aPath: String) : iRouter4DSwitch; +begin + Result := Self; + Router4DHistory.RemoveHistory(aPath); +end; + +end. diff --git a/src/Router4D.Utils.pas b/src/Router4D.Utils.pas new file mode 100644 index 0000000..a2abf54 --- /dev/null +++ b/src/Router4D.Utils.pas @@ -0,0 +1,82 @@ +unit Router4D.Utils; + +interface + +uses + System.Rtti, + Router4D.Props, + SysUtils, + Classes; + +type + TRouter4DUtils = class + private + public + class function CreateInstance : T; + end; + + TNotifyEventWrapper = class(TComponent) + private + FProc: TProc; + FAux : String; + public + constructor Create(Owner: TComponent; Proc: TProc; Aux : String = ''); virtual; + class function AnonProc2NotifyEvent(Owner: TComponent; Proc: TProc; Aux : String = ''): TNotifyEvent; + published + procedure Event(Sender: TObject); + end; + +implementation + +{ TRouter4DUtils } + +class function TRouter4DUtils.CreateInstance: T; +var + AValue: TValue; + ctx: TRttiContext; + rType: TRttiType; + AMethCreate: TRttiMethod; + instanceType: TRttiInstanceType; +begin + ctx := TRttiContext.Create; + rType := ctx.GetType(TypeInfo(T)); + for AMethCreate in rType.GetMethods do + begin + if (AMethCreate.IsConstructor) and (Length(AMethCreate.GetParameters) = 1) then + begin + instanceType := rType.AsInstance; + AValue := AMethCreate.Invoke(instanceType.MetaclassType, [nil]); + Result := AValue.AsType; + + try + GlobalEventBus.RegisterSubscriber(AValue.AsType); + except + + end; + + Exit; + end; + end; + +end; + +{ TNotifyEventWrapper } + +class function TNotifyEventWrapper.AnonProc2NotifyEvent(Owner: TComponent; Proc: TProc; Aux : String = ''): TNotifyEvent; +begin + Result := Self.Create(Owner, Proc, Aux).Event; +end; + +constructor TNotifyEventWrapper.Create(Owner: TComponent; Proc: TProc; Aux : String = ''); +begin + inherited Create(Owner); + FProc := Proc; + FAux := Aux; +end; + +procedure TNotifyEventWrapper.Event(Sender: TObject); +begin + FProc(Sender, FAux); +end; + +end. diff --git a/src/Router4D.pas b/src/Router4D.pas new file mode 100644 index 0000000..f718b67 --- /dev/null +++ b/src/Router4D.pas @@ -0,0 +1,90 @@ +unit Router4D; + +interface + +uses + System.Generics.Collections, + System.Classes, + System.Rtti, + System.TypInfo, + SysUtils, + FMX.Types, + Router4D.Interfaces, + Router4D.History, + Router4D.Render, + Router4D.Link; + +type + TRouter4D = class(TInterfacedObject, iRouter4D) + private + public + constructor Create; + destructor Destroy; override; + class function New : iRouter4D; + class function Render : iRouter4DRender; + class function Link : iRouter4DLink; + class function Switch : iRouter4DSwitch; + class function SideBar : iRouter4DSidebar; + end; + +implementation + +{ TRouter4Delphi } + +uses + Router4D.Utils, + Router4D.Switch, + Router4D.Sidebar; + +constructor TRouter4D.Create; +begin + +end; + +destructor TRouter4D.Destroy; +begin + + inherited; +end; + +class function TRouter4D.Link: iRouter4DLink; +begin + Result := TRouter4DLink.New; +end; + +class function TRouter4D.New: iRouter4D; +begin + Result := Self.Create; +end; + +class function TRouter4D.Render: iRouter4DRender; +begin + Router4DHistory + .AddHistory( + TPersistentClass(T).ClassName, + TPersistentClass(T) + ); + + + Result := + TRouter4DRender + .New( + Router4DHistory + .GetHistory( + TPersistentClass(T) + .ClassName + ) + ); +end; + +class function TRouter4D.SideBar: iRouter4DSidebar; +begin + Result := TRouter4DSidebar.New; +end; + +class function TRouter4D.Switch: iRouter4DSwitch; +begin + Result := TRouter4DSwitch.New; +end; + +end.