Open Tools API - Um TDataModule com propriedades e métodos adicionais

Um TDataModule com propriedades e métodos adicionais

Na parte anterior deste artigo foi demonstrado que com o OTA é possível controlar a IDE a ponto de podermos registrar um TForm especial com características avançadas (e práticas) e que gera seu próprio código-fonte inicial. Demonstramos com isso que é possível controlar tanto o editor de código da IDE como o Form Designer. Agora, nesta parte final do artigo, eu vou usar boa parte das técnicas aplicadas ao TForm da seção anterior para criar um TDataModule com propriedades e métodos adicionais para manipulação de DataSets, DataSources e SQLs. Como boa parte dos arquivos-fonte básicos foram apresentados na seção anterior, eu vou me limitar aqui a falar exclusivamente dos fontes necessários para criar o TDataModule especial.

ZOOW.Wizards.DataModule.Wizard.pas

unit ZOOW.Wizards.DataModule.Wizard;

interface

uses Windows
   , ToolsApi
   , ZOOW.Lib.ToolsAPI.OTA.Creators
   , ZOOW.Wizards.Base;

type
  { Definição deste Wizard }
  TZOOWDataModuleWizard = class(TZOOWWizard)
  protected
    function GetIDString: string; override;
    function GetName: string; override;
    procedure Execute; override;

    function GetComment: string; override;
    function GetPage: string; override;
    function GetGlyph: Cardinal; override;

    function GetGalleryCategory: IOTAGalleryCategory; override;

    property GalleryCategory: IOTAGalleryCategory read GetGalleryCategory;
    property Personality;
  end;

  { Para cada formulário, datamodule ou frame devemos criar aqui uma classe
  para manipular seu código-fonte e incluir a Unit correta na cláusula USES }
  TZOOWDataModuleFileCreator = class(TModuleCreatorFile)
  public
    function GetSource: string; override;
  end;

  { Para cada formulário, datamodule ou frame devemos criar aqui uma classe
  para indicar o ancestral e qual o TModuleCreatorFile associado }
  TZOOWDataModuleModuleCreator = class(TFormCreatorModule)
  public
    function GetAncestorName: string; override;
    function GetImplFile: TModuleCreatorFileClass; override;
  end;

implementation

uses SysUtils
   , DateUtils;

const
  { As 3 constantes a seguir definem onde o Wizard vai aparecer. Wizards com
  estas mesmas informações, aparecem no mesmo lugar no Object Repository }
  OBJECT_REPOSITORY_CATEGORY_ID = 'ZOOW.WIZARD';
  OBJECT_REPOSITORY_CATEGORY_NAME = 'Zetta-Ømnis OTA Wizards';
  OBJECT_REPOSITORY_PAGE_NAME = OBJECT_REPOSITORY_CATEGORY_NAME;
  { As 3 constantes a seguir identificam este Wizard especificamente. Cada
  Wizard diferente deve ter suas próprias informações nas 3 constantes }
  WIZARD_ID = 'ZETTAOMNIS.OTA.WIZARD.DATAMODULE'; { EMPRESA.PRODUTO.TIPO.NOME }
  WIZARD_NAME = 'Zetta-Ømnis DataModule';
  WIZARD_COMMENT = 'DataModule com opções avançadas adicionais. Contém coleçõ' +
  'es automaticamente preenchidas com todos os TDataSet, TDataSource e TClien' +
  'tDataSet de forma a facilitar o acesso iterativo a esses componentes. Cont' +
  'ém uma propriedade exclusiva para armazenamento de SQLs parametrizados, o ' +
  'que torna o código-fonte mais limpo e legível';
  WIZARD_ICONS = 'ZOOW_DATAMODULE_ICONS';
  { As duas constantes a seguir são substituídas dentro da constante
  FILE_CONTENT }
  DEFINITIONUNIT = 'ZOOW.Wizards.DataModule';
  ANCESTOR_ID = 'ZOOWDataModule'; { Sem o "T" inicial }

  FILE_CONTENT =
  'unit <UNITNAME>;'#13#10#13#10 +

  '{ Zetta-Ømnis DataModule. Copyright <COPYRIGHTYEAR> Zetta-Ømnis Soluções Tecnológicas Ltda. }'#13#10#13#10 +

  'interface'#13#10#13#10 +

  'uses'#13#10 +
  '  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,'#13#10 +
  '  <DEFINITIONUNIT>;'#13#10#13#10 +

  'type'#13#10 +
  '  T<CLASS_ID> = class(T<ANCESTOR_ID>)'#13#10 +
  '  private'#13#10 +
  '    { Declarações privadas }'#13#10 +
  '  protected'#13#10 +
  '    { Declarações protegidas }'#13#10 +
  '  public'#13#10 +
  '    { Declarações públicas }'#13#10 +
  '  end;'#13#10#13#10 +

  'implementation'#13#10#13#10 +

  '{$R *.dfm}'#13#10#13#10 +

  'end.';

var
  DelphiCategory: IOTAGalleryCategory;

{ TZOOWDataModuleModuleCreator }

function TZOOWDataModuleModuleCreator.GetAncestorName: string;
begin
  Result := ANCESTOR_ID;
end;

function TZOOWDataModuleModuleCreator.GetImplFile: TModuleCreatorFileClass;
begin
  Result := TZOOWDataModuleFileCreator;
end;

{ TZOOWDataModuleFileCreator }

function TZOOWDataModuleFileCreator.GetSource: string;
begin
  { <UNITNAME>, <CLASS_ID> e <ANCESTOR_ID> serão substituídos automaticamente na
  classe pai TModuleCreatorFile em ZOOW.Lib.ToolsAPI.OTA.Creators.pas.
  <UNITNAME> e <CLASS_ID> são obtidos automaticamente dependendo daquilo que o
  usuários escolheu ao salvar a unit e a classe. <ANCESTOR_ID> é conhecido
  porque aqui, em TZOOWDataModuleModuleCreator.GetAncestorName, estamos
  informando o nome da classe ancestral desse nosso DataModule especial }

  Result := StringReplace(FILE_CONTENT, '<DEFINITIONUNIT>', DEFINITIONUNIT, [rfIgnoreCase]);
  Result := StringReplace(Result,'<COPYRIGHTYEAR>',IntToStr(YearOf(Now)) + ' / ' + IntToStr(YearOf(Now) + 1),[rfIgnoreCase]);
  Result := inherited GetSource;
end;

{ TZOOWDataModuleWizard }

procedure TZOOWDataModuleWizard.Execute;
begin
  inherited;
  (BorlandIDEServices as IOTAModuleServices).CreateModule(TZOOWDataModuleModuleCreator.Create);
end;

function TZOOWDataModuleWizard.GetComment: string;
begin
  Result := WIZARD_COMMENT;
end;

function TZOOWDataModuleWizard.GetIDString: string;
begin
  Result := WIZARD_ID;
end;

function TZOOWDataModuleWizard.GetName: string;
begin
  Result := WIZARD_NAME;
end;

function TZOOWDataModuleWizard.GetPage: string;
begin
  Result := OBJECT_REPOSITORY_PAGE_NAME;
end;

function TZOOWDataModuleWizard.GetGalleryCategory: IOTAGalleryCategory;
begin
  Result := DelphiCategory;
end;

function TZOOWDataModuleWizard.GetGlyph: Cardinal;
begin
  Result := LoadIcon(hInstance, WIZARD_ICONS);
end;

initialization
  DelphiCategory := AddDelphiCategory(OBJECT_REPOSITORY_CATEGORY_ID, OBJECT_REPOSITORY_CATEGORY_NAME);

finalization
  RemoveCategory(DelphiCategory);

end.

Esta unit tem a mesma função da unit ZOOW.Wizards.Form.Wizard.pas, ou seja, definir o wizard para o TDataModule especial. Ela é praticamente igual a ZOOW.Wizards.Form.Wizard.pas e isto é natural, já que, do ponto de vista do OTA, tanto um TForm como um TDataModule são simplesmente "um módulo" e se você observar com atenção, ao abrir um TForm ou um TDataModule no Delphi você verá que eles são semelhantes comportamental e estruturalmente. Ambos tem uma classe (claro) e ambos possuem um arquivo .dfm que pode ser alguma forma manipulado em tempo de projeto. Enquanto o TForm permite que se adicionem componentes não visuais e controles, o TDataModule permite apenas componentes não visuais. A diferença óbvia ocorrem em tempo de execução, quando o TForm pode ser visualizado e o TDataModule não, contudo, em tempo de projeto, que é o domínio do OTA, ambos, TForm e TDataModule, são manipulados da mesma forma!

Em termos de código-fonte, a diferença desta unit para a unit ZOOW.Wizards.Form.Wizard.pas é que ela possui informações referentes ao TDataModule. Não vou explicar novamente, pois isso foi feito para a unit ZOOW.Wizards.Form.Wizard.pas e sendo assim, caso queira entender alguns pormenores, volte ao tópico ZOOW.Wizards.Form.Wizard.pas. Abaixo é apresentada a tela "New Items" do Delphi, exibindo nosso wizard, bem como o wizard do nosso TForm especial, definido anteriormente neste artigo:

ZOOW.Wizards.DataModule.pas

(*******************************************************************************
Zetta-Ømnis DataModule.

Esta unit define um Zetta-Ømnis DataModule, com todos os seus métodos e
propriedades. Uma instância desta classe é criada pelo wizard.

@Author  Carlos
@Version 13/12/2016
*******************************************************************************)
unit ZOOW.Wizards.DataModule;

interface

uses Classes, DB, DBClient, ExtCtrls, ZOOW.Wizards.Form;

type
  TCreationTime = (ctUndefined, ctDesignTime, ctRunTime);

  { == Coleção de SQLs que são salvas com o DFM ============================== }
  TSQLItem = class (TCollectionItem)
  private
    FSQL: TStrings;
    FName: String;
    FDescription: String;
    procedure SetSQL(const Value: TStrings);
    procedure SetDescription(const Value: String);
    procedure SetName(const Value: String);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(aCollection: TCollection); override;
    destructor Destroy; override;
  published
    property SQL: TStrings read FSQL write SetSQL;
    property Name: String read FName write SetName;
    property Description: String read FDescription write SetDescription;
  end;

  TSQLCollection = class (TCollection)
  private
    FDataModule: TDataModule;
    function GetSQLItem(aIndex: Word): TSQLItem;
    function GetSQLItemByID(aID: String): TSQLItem;
  protected
   	function Add: TSQLItem;
    constructor Create(aDataModule: TDataModule);
  public
    property SQLItem[aIndex: Word]: TSQLItem read GetSQLItem;
    property SQLItemByID[aID: String]: TSQLItem read GetSQLItemByID; default;
  end;
  { ========================================================================== }

  { O campo FPtr sempre guarda um ponteiro para o componente sendo
  colocado na coleção. Isso é necessário pois alguns componentes colocados nos
  datamodules são modificados por classes interposer e não há meios realizar um
  type cast bem sucedido usando apenas aquilo que é salvo na coleção, devido ao
  fato de que o que é salvo na coleção sempre é a versão padrão do componente,
  isto é, que não passou pela classe interposer, tornando o cast impossível.
  Tentativas de cast direto mostraram que os membros inseridos pela classe
  interposer nunca eram acessíveis. Ao dar um cast usando o ponteiro, toda
  informação é conseguida sem problemas. Por exemplo:

  TClientDataSet(ClientDataSets['CLDSUsuarios']).MembroInseridoEmClasseInterposer

  Vai compilar, mas vai gerar uma Runtime Exception, enquanto que

  TClientDataSet(ClientDataSets['CLDSUsuarios'].Ptr^).MembroInseridoEmClasseInterposer

  Vai funcionar sem problemas }

  { == Coleção de DataSets =================================================== }
  TDataSetItem = class (TCollectionItem)
  private
    FCreationTime: TCreationTime;
    FDataSet: TDataSet;
    FPtr: Pointer;
  public
    constructor Create(aCollection: TCollection); override;
    destructor Destroy; override;

    property CreationTime: TCreationTime read FCreationTime default ctUndefined;
    property DataSet: TDataSet read FDataSet;
    property Ptr: Pointer read FPtr;
  end;

  TDataSetCollection = class;

  TDataSetEnumerator = class
  private
    FCollection: TDataSetCollection;
    FIndex: Integer;
  public
    constructor Create(PCollection: TDataSetCollection);
    function GetCurrent: TDataSetItem;
    function MoveNext: Boolean;
    property Current: TDataSetItem read GetCurrent;
  end;

  TDataSetCollection = class (TCollection)
  private
    FDataModule: TDataModule;
    function GetDataSetItem(aIndex: Word): TDataSetItem;
    function GetDataSetItemByDataSetName(aDataSetName: String): TDataSetItem;
  protected
   	function Add: TDataSetItem;
    constructor Create(aDataModule: TDataModule);
  public
    function AddDataSet(aDataSetClass: TDataSetClass; aName: String): TDataSetItem;
    function GetEnumerator: TDataSetEnumerator;

    property DataSetItem[aIndex: Word]: TDataSetItem read GetDataSetItem;
    property DataSetItemByDataSetName[aDataSetName: String]: TDataSetItem read GetDataSetItemByDataSetName; default;
  end;
  { ========================================================================== }

  { == Coleção de DataSources ================================================ }
  TDataSourceItem = class (TCollectionItem)
  private
    FCreationTime: TCreationTime;
    FDataSource: TDataSource;
    FPtr: Pointer;
  public
    constructor Create(aCollection: TCollection); override;
    destructor Destroy; override;

    property CreationTime: TCreationTime read FCreationTime default ctUndefined;
    property DataSource: TDataSource read FDataSource;
    property Ptr: Pointer read FPtr;
  end;

  TDataSourceClass = class of TDataSource;

  TDataSourceCollection = class;

  TDataSourceEnumerator = class
  private
    FCollection: TDataSourceCollection;
    FIndex: Integer;
  public
    constructor Create(PCollection: TDataSourceCollection);
    function GetCurrent: TDataSourceItem;
    function MoveNext: Boolean;
    property Current: TDataSourceItem read GetCurrent;
  end;

  TDataSourceCollection = class (TCollection)
  private
    FDataModule: TDataModule;
    function GetDataSourceItem(aIndex: Word): TDataSourceItem;
    function GetDataSourceItemByName(aDataSourceName: String): TDataSourceItem;
  protected
   	function Add: TDataSourceItem;
    constructor Create(aDataModule: TDataModule);
  public
    function AddDataSource(aDataSourceClass: TDataSourceClass; aName: String): TDataSourceItem;
    function GetEnumerator: TDataSourceEnumerator;

    property DataSourceItem[aIndex: Word]: TDataSourceItem read GetDataSourceItem;
    property DataSourceItemByName[aDataSourceName: String]: TDataSourceItem read GetDataSourceItemByName; default;
  end;
  { ========================================================================== }

  { = Coleção de ClientDataSets ============================================== }
  TClientDataSetItem = class (TCollectionItem)
  private
    FCreationTime: TCreationTime;
    FClientDataSet: TClientDataSet;
    FPtr: Pointer;
  public
    constructor Create(aCollection: TCollection); override;
    destructor Destroy; override;

    property CreationTime: TCreationTime read FCreationTime default ctUndefined;
    property ClientDataSet: TClientDataSet read FClientDataSet;
    property Ptr: Pointer read FPtr;
  end;

  TClientDataSetClass = class of TClientDataSet;

  TClientDataSetCollection = class;

  TClientDataSetEnumerator = class
  private
    FCollection: TClientDataSetCollection;
    FIndex: Integer;
  public
    constructor Create(PCollection: TClientDataSetCollection);
    function GetCurrent: TClientDataSetItem;
    function MoveNext: Boolean;
    property Current: TClientDataSetItem read GetCurrent;
  end;

  TClientDataSetCollection = class (TCollection)
  private
    FDataModule: TDataModule;
    function GetClientDataSetItem(aIndex: Word): TClientDataSetItem;
    function GetClientDataSetItemByClientDataSetName(aClientDataSetName: String): TClientDataSetItem;
  protected
   	function Add: TClientDataSetItem;
    constructor Create(aDataModule: TDataModule);
  public
    function AddClientDataSet(aClientDataSetClass: TClientDataSetClass; aName: String): TClientDataSetItem;
    function GetEnumerator: TClientDataSetEnumerator;

    property ClientDataSetItem[aIndex: Word]: TClientDataSetItem read GetClientDataSetItem;
    property ClientDataSetItemByClientDataSetName[aClientDataSetName: String]: TClientDataSetItem read GetClientDataSetItemByClientDataSetName; default;
  end;
  { ========================================================================== }

  TZOOWDataModuleClass = class of TZOOWCustomDataModule;

  PZOOWDataModule = ^TZOOWCustomDataModule;

  TBeforeCreateMyForm = procedure(const aMyFormClass: String) of object;
  TAfterCreateMyForm = procedure(const aZOOWForm: TZOOWForm) of object;

  TZOOWCustomDataModule = class(TDataModule)
  private
    FMyReference: PZOOWDataModule;
    FDataSources: TDataSourceCollection;
    FDataSets: TDataSetCollection;
    FClientDataSets: TClientDataSetCollection;
    FSQLs: TSQLCollection;
    FMyForm: TZOOWForm;
    FMyFormClass: String;
    FTimer: TTimer;
    FOnBeforeCreateMyForm: TBeforeCreateMyForm;
    FOnAfterCreateMyForm: TAfterCreateMyForm;
    procedure DoTimer(aSender: TObject);
  protected
    property MyForm: TZOOWForm read FMyForm;
    property SQLs: TSQLCollection read FSQLs write FSQLs;
    property MyFormClass: String read FMyFormClass write FMyFormClass;
    property OnBeforeCreateMyForm: TBeforeCreateMyForm read FOnBeforeCreateMyForm write FOnBeforeCreateMyForm;
    property OnAfterCreateMyForm: TAfterCreateMyForm read FOnAfterCreateMyForm write FOnAfterCreateMyForm;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    class procedure CreateMe(    aOwner             : TComponent;
                             var aReference;        { não tem tipo! }
                                 aZOOWDataModuleClass: TZOOWDataModuleClass); static;
    procedure DestroyMe(aDelayMS: Word = 0);

    property DataSources: TDataSourceCollection read FDataSources;
    property DataSets: TDataSetCollection read FDataSets;
    property ClientDataSets: TClientDataSetCollection read FClientDataSets;
  end;

  TZOOWDataModule = class(TZOOWCustomDataModule)
  public
    property MyForm;
  published
    property SQLs;
    property MyFormClass;
    property OnBeforeCreateMyForm;
    property OnAfterCreateMyForm;
  end;

implementation

uses SysUtils, Forms;

{ TZOOWDataModule }

constructor TZOOWCustomDataModule.Create(aOwner: TComponent);
var
  i: Word;
begin
  FDataSources             := TDataSourceCollection.Create(Self);
  FDataSets                := TDataSetCollection.Create(Self);
  FClientDataSets          := TClientDataSetCollection.Create(Self);
  FSQLs                    := TSQLCollection.Create(Self);
  FMyForm                  := nil;

  inherited;

  if ComponentCount > 0 then
    for i := 0 to Pred(ComponentCount) do
      if Components[i] is TDataSource then
        with FDataSources.Add do
        begin
          FDataSource := TDataSource(Components[i]);
          FCreationTime := ctDesignTime;
          FPtr := FDataSource;
        end
      else if Components[i] is TClientDataSet then
        with FClientDataSets.Add do
        begin
          FClientDataSet := TClientDataSet(Components[i]);
          FCreationTime := ctDesignTime;
          FPtr := @FClientDataSet;
        end
      else if Components[i] is TDataSet then
        with FDataSets.Add do
        begin
          FDataSet := TDataSet(Components[i]);
          FCreationTime := ctDesignTime;
          FPtr := @FDataSet;
        end;

  if FMyFormClass <> '' then
  begin
    if not Assigned(GetClass(FMyFormClass)) then
      raise Exception.Create('A classe ' + FMyFormClass + ' não foi registrada');

    if not GetClass(FMyFormClass).InheritsFrom(TZOOWForm) then
      raise Exception.Create(FMyFormClass + ' não é uma classe descendente de ' + TZOOWForm.ClassName);

    if Assigned(FOnBeforeCreateMyForm) then
      FOnBeforeCreateMyForm(FMyFormClass);

    FMyForm := TZOOWFormClass(GetClass(FMyFormClass)).Create(Self);

    if Assigned(FOnAfterCreateMyForm) then
      FOnAfterCreateMyForm(FMyForm);
  end;
end;

destructor TZOOWCustomDataModule.Destroy;
begin
  { Só é preciso destruir as coisas se realmente uma instância deste DM foi
  criada e isso só não é feito caso exceções sejam lançadas dentro do construtor }
  if Assigned(FMyReference) then
  begin
    FMyReference^ := nil;

    FSQLs.Free;
    FClientDataSets.Free;
    FDataSets.Free;
    FDataSources.Free;
  end;

  inherited;
end;

class procedure TZOOWCustomDataModule.CreateMe(   aOwner             : TComponent;
                                              var aReference;        { não tem tipo! }
                                                  aZOOWDataModuleClass: TZOOWDataModuleClass);
begin
  if Assigned(TZOOWCustomDataModule(aReference)) then
    raise Exception.Create('O parâmetro aReference contém uma variável não vazia');

  TZOOWCustomDataModule(aReference) :=  aZOOWDataModuleClass.Create(aOwner);
  TZOOWCustomDataModule(aReference).FMyReference := @aReference;
end;

procedure TZOOWCustomDataModule.DestroyMe(aDelayMS: Word = 0);
begin
  if aDelayMS > 0 then
  begin
    FTimer := TTimer.Create(Self);
    FTimer.Enabled := False;
    FTimer.Interval := aDelayMS;
    FTimer.OnTimer := DoTimer;
    FTimer.Enabled := True;
  end
  else
    FMyReference.Free;
end;

procedure TZOOWCustomDataModule.DoTimer(aSender: TObject);
begin
  FTimer.Enabled := False;
  DestroyMe;
end;

{ TDataSetItem }

constructor TDataSetItem.Create(aCollection: TCollection);
begin
  inherited;
  FCreationTime := ctUndefined;
end;

destructor TDataSetItem.Destroy;
begin
  if FCreationTime = ctRunTime then
    FDataSet.Free;
  inherited;
end;

{ TDataSets }

function TDataSetCollection.Add: TDataSetItem;
begin
	Result := TDataSetItem(inherited Add);
end;

function TDataSetCollection.AddDataSet(aDataSetClass: TDataSetClass; aName: String): TDataSetItem;
begin
  Result := DataSetItemByDataSetName[aName];

  if not Assigned(Result) then
  begin
    Result := Add;
    with Result do
    begin
      FDataSet := aDataSetClass.Create(FDataModule);
      FDataSet.Name := aName;
      FCreationTime := ctRunTime;
    end;
  end;
end;

constructor TDataSetCollection.Create(aDataModule: TDataModule);
begin
  inherited Create(TDataSetItem);
  FDataModule := aDataModule;
end;

function TDataSetCollection.GetDataSetItem(aIndex: Word): TDataSetItem;
begin
	Result := TDataSetItem(inherited Items[aIndex]);
end;

function TDataSetCollection.GetDataSetItemByDataSetName(aDataSetName: String): TDataSetItem;
var
	DSI: Byte;
begin
	Result := nil;

  if Count > 0 then
    for DSI := 0 to Pred(Count) do
      if UpperCase(TDataSetItem(Items[DSI]).DataSet.Name) = UpperCase(aDataSetName) then
      begin
        Result := TDataSetItem(Items[DSI]);
        Break;
      end;
end;

function TDataSetCollection.GetEnumerator: TDataSetEnumerator;
begin
  Result := TDataSetEnumerator.Create(Self);
end;

{ TDataSetEnumerator }

constructor TDataSetEnumerator.Create(PCollection: TDataSetCollection);
begin
  inherited Create;
  FCollection := PCollection;
  FIndex := - 1;
end;

function TDataSetEnumerator.GetCurrent: TDataSetItem;
begin
  Result := TDataSetItem(FCollection.Items[FIndex]);
end;

function TDataSetEnumerator.MoveNext: Boolean;
begin
  Result := FIndex < Pred(FCollection.Count);

  if Result then
    Inc(FIndex);
end;

{ TDataSourceItem }

constructor TDataSourceItem.Create(aCollection: TCollection);
begin
  inherited;
  FCreationTime := ctUndefined;
end;

destructor TDataSourceItem.Destroy;
begin
  if FCreationTime = ctRunTime then
    FDataSource.Free;

  inherited;
end;

{ TDataSourceEnumerator }

constructor TDataSourceEnumerator.Create(PCollection: TDataSourceCollection);
begin
  inherited Create;
  FCollection := PCollection;
  FIndex := - 1;
end;

function TDataSourceEnumerator.GetCurrent: TDataSourceItem;
begin
  Result := TDataSourceItem(FCollection.Items[FIndex]);
end;

function TDataSourceEnumerator.MoveNext: Boolean;
begin
  Result := FIndex < Pred(FCollection.Count);

  if Result then
    Inc(FIndex);
end;

{ TDataSources }

function TDataSourceCollection.Add: TDataSourceItem;
begin
	Result := TDataSourceItem(inherited Add);
end;

function TDataSourceCollection.AddDataSource(aDataSourceClass: TDataSourceClass; aName: String): TDataSourceItem;
begin
  Result := DataSourceItemByName[aName];

  if not Assigned(Result) then
  begin
    Result := Add;
    with Result do
    begin
      FDataSource := aDataSourceClass.Create(FDataModule);
      FDataSource.Name := aName;
      FCreationTime := ctRunTime;
    end;
  end;
end;

constructor TDataSourceCollection.Create(aDataModule: TDataModule);
begin
  inherited Create(TDataSourceItem);
  FDataModule := aDataModule;
end;

function TDataSourceCollection.GetDataSourceItemByName(aDataSourceName: String): TDataSourceItem;
var
	DSI: Byte;
begin
	Result := nil;

  if Count > 0 then
    for DSI := 0 to Pred(Count) do
      if UpperCase(TDataSourceItem(Items[DSI]).DataSource.Name) = UpperCase(aDataSourceName) then
      begin
        Result := TDataSourceItem(Items[DSI]);
        Break;
      end;
end;

function TDataSourceCollection.GetEnumerator: TDataSourceEnumerator;
begin
  Result := TDataSourceEnumerator.Create(Self);
end;

function TDataSourceCollection.GetDataSourceItem(aIndex: Word): TDataSourceItem;
begin
	Result := TDataSourceItem(inherited Items[aIndex]);
end;

{ TClientDataSetItem }

constructor TClientDataSetItem.Create(aCollection: TCollection);
begin
  inherited;
  FCreationTime := ctUndefined;
end;

destructor TClientDataSetItem.Destroy;
begin
  if FCreationTime = ctRunTime then
    FClientDataSet.Free;

  inherited;
end;

{ TClientDataSetEnumerator }

constructor TClientDataSetEnumerator.Create(PCollection: TClientDataSetCollection);
begin
  inherited Create;
  FCollection := PCollection;
  FIndex := - 1;
end;

function TClientDataSetEnumerator.GetCurrent: TClientDataSetItem;
begin
  Result := TClientDataSetItem(FCollection.Items[FIndex]);
end;

function TClientDataSetEnumerator.MoveNext: Boolean;
begin
  Result := FIndex < Pred(FCollection.Count);

  if Result then
    Inc(FIndex);
end;

{ TClientDataSets }

function TClientDataSetCollection.Add: TClientDataSetItem;
begin
	Result := TClientDataSetItem(inherited Add);
end;

function TClientDataSetCollection.AddClientDataSet(aClientDataSetClass: TClientDataSetClass; aName: String): TClientDataSetItem;
begin
  Result := ClientDataSetItemByClientDataSetName[aName];

  if not Assigned(Result) then
  begin
    Result := Add;
    with Result do
    begin
      FClientDataSet := aClientDataSetClass.Create(FDataModule);
      FClientDataSet.Name := aName;
      FCreationTime := ctRunTime;
    end;
  end;
end;

constructor TClientDataSetCollection.Create(aDataModule: TDataModule);
begin
  inherited Create(TClientDataSetItem);
  FDataModule := aDataModule;
end;

function TClientDataSetCollection.GetClientDataSetItem(aIndex: Word): TClientDataSetItem;
begin
	Result := TClientDataSetItem(inherited Items[aIndex]);
end;

function TClientDataSetCollection.GetClientDataSetItemByClientDataSetName(aClientDataSetName: String): TClientDataSetItem;
var
	CDI: Byte;
begin
	Result := nil;

  if Count > 0 then
    for CDI := 0 to Pred(Count) do
      if UpperCase(TClientDataSetItem(Items[CDI]).ClientDataSet.Name) = UpperCase(aClientDataSetName) then
      begin
        Result := TClientDataSetItem(Items[CDI]);
        Break;
      end;
end;

function TClientDataSetCollection.GetEnumerator: TClientDataSetEnumerator;
begin
  Result := TClientDataSetEnumerator.Create(Self);
end;

{ TSQLs }

function TSQLCollection.Add: TSQLItem;
begin
	Result := TSQLItem(inherited Add);
end;

constructor TSQLCollection.Create(aDataModule: TDataModule);
begin
  inherited Create(TSQLItem);
  FDataModule := aDataModule;
end;

function TSQLCollection.GetSQLItem(aIndex: Word): TSQLItem;
begin
  Result := TSQLItem(inherited Items[aIndex]);
end;

function TSQLCollection.GetSQLItemByID(aID: String): TSQLItem;
var
	SI: Byte;
begin
	Result := nil;

  if Count > 0 then
    for SI := 0 to Pred(Count) do
      if UpperCase(TSQLItem(Items[SI]).Name) = UpperCase(aID) then
      begin
        Result := TSQLItem(Items[SI]);
        Break;
      end;
end;

{ TSQLItem }

constructor TSQLItem.Create(aCollection: TCollection);
begin
  inherited;
  FSQL := TStringList.Create;
end;

destructor TSQLItem.Destroy;
begin
  FSQL.Free;
  inherited;
end;

function TSQLItem.GetDisplayName: string;
begin
  Result := FName;
end;

procedure TSQLItem.SetDescription(const Value: String);
var
	SI: Byte;
begin
  if Collection.Count > 0 then
    for SI := 0 to Pred(Collection.Count) do
      if UpperCase(TSQLItem(Collection.Items[SI]).Description) = UpperCase(Value) then
        raise Exception.Create('A descrição escolhida já consta na lista de SQLs. Por favor escolha outra descrição');

  FDescription := UpperCase(Value);
end;

procedure TSQLItem.SetName(const Value: String);
var
	SI: Byte;
begin
  if Collection.Count > 0 then
    for SI := 0 to Pred(Collection.Count) do
      if UpperCase(TSQLItem(Collection.Items[SI]).Name) = UpperCase(Value) then
        raise Exception.Create('O nome escolhido já consta na lista de SQLs. Por favor escolha outro nome');


  if not IsValidIdent(Value,True)  then
    raise Exception.Create('O nome deve seguir a mesma convenção de nomes dos identificadores Delphi');

  FName := UpperCase(Value);
end;

procedure TSQLItem.SetSQL(const Value: TStrings);
begin
  FSQL.Assign(Value);
end;

end.

Tal como o TForm, o TDataModule, pode ser considerado um componente, e como tal ele precisa da classe que o define. Esta unit é onde definimos a classe de nosso TDataModule especial, com todas as suas características avançadas, propriedades e métodos que o farão funcionar de forma adequada.

Hoje é sexta-feira santa, dia de descanso e reflexão, por isso eu vou me reservar o direito de não explicar o que essa unit está fazendo. Fica como desafio para você, caro leitor, ler e entender o que está sendo feito. Garanto que não é tão complicado como parece, desde que você tenha uma boa base em orientação a objetos e/ou criação de componentes. A unit possui alguns comentários que o ajudarão a entender melhor a implementação, além do mais, o exemplo anexado ao artigo tornará esta tarefa ainda mais fácil, logo, acabo de rebaixar esta minha solicitação de "desafio" para "presente de Páscoa" ;)

A imagem abaixo mostra o nosso TDataModule em tempo de projeto, bem como o Object Inspector e a nossa propriedade published SQLs, através da qual podemos manipular de forma visual várias consultas SQL. A imagem foi obtida a partir do exemplo anexado a este artigo, aberto no Delphi XE5.

Os SQLs ficam salvos em uma coleção do tipo TSQLCollection que fica associada ao arquivo .dfm do TDataModule. A imagem abaixo mostra esta coleção com alguns SQLs e o Object Inspector exibindo algumas propriedades de um desses SQLs. Cada item desta coleção é nomeado, de forma a simplificar a utilização de qualquer um dos SQLs, além de possuir uma breve descrição, a fim de dar ao desenvolvedor uma informação sobre o que o SQL faz, sem que o mesmo precise analisar o SQL em si.

O código-fonte (pas) ficará limpo, sem conter SQLs dinâmicos, os quais podem ser acessados em tempo de execução pelo seu nome, simplesmente executando, por exemplo:

procedure TZOODataModule.ZOOWDataModuleCreate(Sender: TObject);
begin
  Query1.SQL.Text := SQLs['TODOS_OS_CLIENTES'];
  Query1.Open;
end;

Além desta característica que eu considero bastante atrativa por si só, o nosso TDataModule especial também contém uma série de propriedades e métodos para manipulação facilitada de TDataSets, TClientDataSets e TDataSources em tempo de execução. O trecho de código a seguir, presente no demo anexado a este artigo, adiciona estes componentes cada qual em uma coleção específica (DataSets, ClientDataSets e DataSources):

procedure TDAMOSecundario.ZOOWDataModuleCreate(Sender: TObject);
begin
  DataSets.AddDataSet(TQuery,'QueryExtra1'); { TODO : Adiciona uma TQuery em Runtime }
  DataSets.AddDataSet(TQuery,'QueryExtra2'); { TODO : Adiciona outra TQuery em Runtime }
  DataSets.AddDataSet(TTable,'TableExtra1'); { TODO : Adiciona uma TTable em Runtime }
  DataSets.AddDataSet(TTable,'TableExtra1'); { TODO : Não adiciona, porque já existe na lista }

  ClientDataSets.AddClientDataSet(TClientDataSet,'ClientDataSetExtra'); { TODO : Adiciona um TClientDataSet }

  DataSources.AddDataSource(TDataSource,'DASOQURY1').DataSource.DataSet := QURY1; { TODO : Adiciona um TDataSource e associa ele à QURY1 (designtime) }
  DataSources.AddDataSource(TDataSource,'DASOTABL1').DataSource.DataSet := TABL1; { TODO : Adiciona um TDataSource e associa ele à TABL1 (designtime) }
  DataSources.AddDataSource(TDataSource,'DASOClientDataSetExtra').DataSource.DataSet := ClientDataSets['ClientDataSetExtra'].ClientDataSet; { TODO : Adiciona um TDataSource e associa ele à ClientDataSetExtra (runtime) }
end;

Note que, tal como acontece com a lista de SQLs, é possível acessar cada item de cada uma das coleções a partir do nome que foi dado a ele. Isso pode ser visto na última linha do trecho de código acima.

Conclusão

Isso é tudo que eu tenho para falar sobre o OTA, no entanto isto é apenas a ponta do iceberg. Todos os grandes experts como o CnPack e o GExperts utilizam o OTA ao extremo mas eu não tenho tal nível de conhecimento para lhes mostrar exemplos mais avançados, entretanto, eu garanto que se você leu e entendeu o que eu expliquei neste artigo você vai poder criar alguns wizards muito interessantes que vão, sem sombra de dúvida, aumentar sua produtividade.

MyFormClass (Bônus Track hehehe)

Uma das propriedades existentes no nosso TDataModule especial pode ter passado despercebida para muitos de vocês, mas ela merece uma menção honrosa aqui porque eu a considero muito útil caso você tenha interesse em desenvolver algum framework. Trata-se da propriedade MyFormClass, que não tem nada a ver com OTA, mas que eu resolvi incluir no demo anexado a este artigo, porque eu acho que vocês merecem saber sobre isso.

Há algum tempo atrás eu desenvolvi um modelo de desenvolvimento (chame de framework se quiser), na qual cada TForm possui um TDataModule associado. O papel do TDataModule neste modelo de desenvolvimento era o de agrupar regras de negócio de cada TForm, deixando o TForm apenas como mero exibidor de conteúdo. Dentro deste modelo o TDataModule possui papel essencial e precisa ser criado ANTES do TForm associado a ele, logo, eu precisei de uma forma limpa de criar um TForm qualquer a partir de um TDataModule e minhas pesquisas me levaram àquilo que eu incluí nos exemplos de OTA. Eu não vou dar muitos detalhes a respeito, porque você poderá entender melhor o funcionamento olhando os códigos-fonte.

Basicamente, ao configurar a propriedade MyFormClass de nosso TDataModule com o nome da classe de um de nossos TForms especiais, o TDataModule conseguirá criar e gerenciar o ciclo de vida deste TForm, destruindo-o automaticamente. Na unit UFormPrincipal.pas, do exemplo anexado a este artigo existe o seguinte método:

procedure TFormPrincipal.BUTNFormSecundarioShowModalClick(Sender: TObject);
begin
  FDAMOSecundarioShowModal := nil;
  TDAMOSecundario.CreateMe(Self,FDAMOSecundarioShowModal,TDAMOSecundario);
  FDAMOSecundarioShowModal.MyForm.Position := poScreenCenter;
  FDAMOSecundarioShowModal.MyForm.ShowModal;
end;

Explicando rapidamente, TDAMOSecundario.CreateMe cria uma instância de TDAMOSecundario e coloca a referência no campo FDAMOSecundario. Na propriedade MyForm de FDAMOSecundario existe a instância do TForm que foi automaticamente criado juntamente com TDAMOSecundario. Na propriedade MyFormClass de TDAMOSecundario existe o nome da classe do TForm que foi criado automaticamente por TDAMOSecundario.

Como o TDataModule sabe onde está a classe a fim de criá-la? Se você é um leitor atento e um programador curioso, deve ter notado que no código-fonte de nosso TForm especial, no final do mesmo, existe uma linha diferente, veja novamente:

unit Unit1;

{ Zetta-Ømnis Form. Copyright 2017 / 2018 Zetta-Ømnis Soluções Tecnológicas Ltda. }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  ZOOW.Wizards.Form;

type
  TZOOWForm1 = class(TZOOWForm)
  private
    { Declarações privadas }
  protected
    { Declarações protegidas }
  public
    { Declarações públicas }
  end;

implementation

{$R *.dfm}

initialization
  RegisterClass(TZOOWForm1)

end.

Na seção initialization existe o procedure RegisterClass, o qual registra a classe que está em seu parâmetro, de forma que, posteriormente, de qualquer lugar do código, possamos criar uma instância dessa classe apenas conhecendo seu nome. A forma como isso é feito pode ser vista no construtor do nosso TDataModule especial em ZOOW.Wizards.DataModule.pas.

Divirta-se analisando este exemplo :)

  Arquivos anexados  

Arquivo	Descrição	Tamanho	Modificado em
ZOOW	Exemplos de utilização básica do OTA (Mais Bonus Track)	41 KB	14/04/2017 às 15:45