Open Tools API

Qualidade: 

Estrela ativaEstrela ativaEstrela ativaEstrela ativaEstrela ativa
 

Páginas neste artigo

O que é o OTA?

O Open Tools API é um conjunto de cerca de 100 interfaces que permite a interação e o controle da IDE, incluindo seu menu principal, a barra de ferramentas, a lista de ações principal (TActionManager) e sua lista de imagens (TImageList), o editor de código-fonte, os macros de teclado bem como o mapeamento de suas teclas, os formulários e seus componentes no editor de formulários em tempo de projeto, o debugador e o processo sendo debugado, o Code Completion, a lista de mensagens e a lista To-Do1.

Resumindo essa descrição da Embarcadero, o OTA é o meio através do qual você, como programador, é habilitado a fazer o que quiser com a IDE, deixando-a literalmente do seu jeito e estendendo-a de forma a tornar sua produtividade tendendo ao infinito! Pode parecer exagerada essa minha explicação resumida, mas é assim que eu vejo o OTA em sua forma mais básica.

Por que eu devo estender a IDE?

Não, você não precisa estender a IDE, afinal, isso não vai te fazer um programador melhor, no entanto, se você tiver paciência para ler a série de artigos e executar os exemplos que eu vou anexar, certamente em algum momento você vai se perguntar "como eu passei tanto tempo sem nunca ter estendido a IDE em meu favor?".

O que eu devo esperar desta série de artigos?

O OTA é um assunto muito extenso e pouco documentado. Boa parte daquilo que será abordado aqui foi compilado de várias fontes, normalmente em línguas estrangeiras e sem muita profundidade, no entanto será suficiente para um conhecimento básico, porém útil e bastante funcional desta tecnologia. Você vai perceber que estender a IDE é mais simples do que parece. O básico é praticamente uma "receita de bolo"; você pode usar as mesmas classes com pequenas modificações e criar uma infinidade de TDataModules ou TForms customizados (por exemplo) cada um servindo a um propósito específico sem muito esforço.

O OTA não se resume apenas a criação de formulários e módulos de dados customizados (caso você ainda não tenha entendido) mas esta série de artigos vai abordar apenas isso. Do meu humilde ponto de vista este simples uso do OTA é algo que pode sim, fazer sua produtividade aumentar, reduzindo seu esforço repetitivo ao introduzir comportamentos e propriedades nos, antes estáticos, TDataModule e TForm.

Além desse ganho, que já compensaria a leitura, eu particularmente acho interessante a forma como o OTA interage com a IDE, sendo capaz de transformar simples pacotes de componentes criados por nós em algo com uma cara mais profissional, ao permitir que ícones personalizados sejam incluídos na tela de Splash e na tela de About do Delphi.

Não tem jeito: nós, como programadores, somos orgulhosos de nossos feitos e eu garanto que você vai se sentir no mínimo feliz ao ver esses ícones aparecendo na sua IDE (Splash e About). No momento em que você ver que pode implementar comportamentos, inclusive visuais, nos TForms você vai se sentir ainda mais recompensado e começará a ver o OTA com outros olhos.

Mesmo assim, se você ainda não se convencer de que este conteúdo é suficiente para você, a única coisa que posso recomendar é que você estenda seus conhecimentos buscando mais informações na Internet. Eu disse que é complicado de achar, mas imagino que usando o conteúdo destes artigos como base, você estará mais apto a buscar o que precisa de forma mais eficiente.

Está gostando do que está lendo? Ajude nosso site visitando nossos patrocinadores. Obrigado! :)

Eu desenvolvo componentes. O que posso esperar?

Eu sempre subintendo que alguém que já desenvolve componentes para Delphi tem uma boa base de Orientação a Objetos. Se você se enquadra nessa categoria de pessoas, excelente! Você não terá problemas para entender os exemplos e ainda vai ficar mais por dentro das interações com a IDE, aumentando assim o seu Know-How do Delphi.

Já que você se identifica como desenvolvedor de componentes Delphi, gostaria de falar rapidamente com você: se você começou agora a desenvolver componentes, pode ter achado estranho eu dizer que usando OTA é possível criar Data Modules e Forms com propriedades e métodos especiais. Isso é totalmente natural. Começando agora a desenvolver componentes você ainda não sabe que criar um TForm ou um TDataModule herdado, como se fosse um componente qualquer simplesmente não funciona! O motivo disso é que o TForm e o TDataModule são componentes que precisam gerar código e arquivos ao serem incluídos no projeto.

Quando você inclui num projeto um TForm, por exemplo, 2 arquivos são criados nos bastidores: o arquivo de fonte .pas e o arquivo de recurso .dfm. Por este motivo não se pode tratar um TForm ou um TDataModule como componentes quaisquer. Eles são especiais porque precisam interagir com a IDE para serem criados corretamente.  Por este motivo, o mecanismo do OTA que gera TForms e TDataModules se chama Wizard

Resumidamente: não, não dá para tratar TForm e TDataModule como componentes ordinários simplesmente estendendo suas respectivas classes e esperando que eles funcionem como seus progenitores. É necessário usar OTA para isso. A interação com a IDE cria wizards (assistentes) que vão criar arquivos e fontes para você.


Ícones nas telas de "Splash" e "About"!

Para começar com os exemplos de OTA eu resolvi falar sobre algo que pode ser usado em qualquer pacote de componentes, mesmo que este não use características mais avançadas do OTA. Suponha que você tenha um pacote de componentes desenvolvido por você, o que você acharia de colocar uma referência a ele na tela de "Splash" do Delphi?

Legal não é mesmo? Dentre vários componentes excelentes e experts realmente úteis, lá está um ícone para representar o seu pacote de componentes. Seu lugar entre os grandes está reservado e você pode se sentir importante, mas não é só isso! Nenhum pacote de componentes está completo sem algumas informações gerais ou de direitos autorais. Sendo assim, acho que seria excelente uma referência ao seu pacote de componentes na tela de "About", não é mesmo?

A inclusão destes ícones e destas informações é bem mais simples do que aparenta ser e eu não vou entrar em detalhes adicionais a respeito disso porque a minha intenção com estes artigos sobre OTA é, de fato, entregar o serviço quase pronto, de forma que você, caro leitor, possa se aprofundar por si só, seja estudando o código, seja procurando mais informações na Internet. Chega de conversa mole, vamos ao que interessa.

Está gostando do que está lendo? Ajude nosso site visitando nossos patrocinadores. Obrigado! :)

Apenas dois arquivos de fonte estão presentes neste exemplo, um deles é o arquivo ZOOW.Wizards.Register.pas, que é o responsável por registrar nossos componentes, wizards e experts por meio do procedure Register:

unit ZOOW.Wizards.Register;

interface

procedure Register;

implementation

uses
  DesignIntf;

procedure Register;
begin
  ForceDemandLoadState(dlDisable);
end;

end.

Obviamente este arquivo está praticamente vazio porque não teremos neste exemplo nenhum wizard, expert ou componente sendo instalado. A única linha que merece menção é a linha 14. ForceDemandLoadState é um procedure que atua na forma como Delphi carrega componentes registrados. Por padrão, o Delphi só carrega componentes quando eles são efetivamente usados e isso é bom para diminuir o consumo de memória, no entanto o carregamento por demanda também impede que os ícones na tela de Splash apareçam.

Eu não sei se isso é um bug ou se eu estou fazendo algo errado, só sei que em todos os exemplos com fonte que eu achei, esta linha estava presente para garantir a exibição de tais ícones. O parâmetro usado (dlDisable), indica que o carregamento por demanda está desabilitado, e que por isso, o carregamento será feito independentemente de qualquer um dos componentes de nosso pacote ser usado ou não. Isso, invariavelmente, vai exibir nosso ícone na tela de Splash, que é nosso objetivo. Para mais detalhes sobre o procedure ForceDemandLoadState, acesse http://docwiki.embarcadero.com/Libraries/Seattle/en/DesignIntf.ForceDemandLoadState.

O segundo arquivo, que é o responsável por, de fato, utilizar o OTA para inclusão de ícones na tela de Splash e About, bem como informações adicionais, é o arquivo ZOOW.Wizards.Information.pas, o qual pode ser visto abaixo:

unit ZOOW.Wizards.Information;

interface

implementation

{$R *.res}

uses
  ToolsAPI, Windows, Graphics, SysUtils, DesignIntf;

const
  ICON_SPLASH = 'SPLASHICON';
  ICON_ABOUT = 'ABOUTICON';

var
  AboutBoxServices: IOTAAboutBoxServices;
  AboutBoxIndex: Integer = 0;

resourcestring
  resPackageName = 'Zetta-Ømnis OTA Wizards';
  resLicense = 'Open Source Donationware';
  resAboutCopyright = 'Copyright Zetta-Ømnis Soluções Tecnológicas Ltda.';
  resAboutTitle = 'Zetta-Ømnis OTA Wizards';
  resAboutDescription = 'O Zetta-Ømnis OTA Wizards é um exemplo disponível no s' +
  'ite wwww.zettaomnis.net.br e visa mostrar 3 usos simples, porém bastante int' +
  'eressantes, do OTA (Open Tools API): Exibição de íncones na tela de splash e' +
  ' about do Delphi (esta tela), um wizard exclusivo que inclui capacidades adi' +
  'cionais ao TDataModule, um wizard exclusivo que inclui capacidades adicionai' +
  's ao TForm';

procedure RegisterSplashScreen;
begin
  SplashScreenServices.AddPluginBitmap(resPackageName, LoadBitmap(HInstance,ICON_SPLASH), False, resLicense);
end;

procedure RegisterAboutBox;
begin
  if Supports(BorlandIDEServices,IOTAAboutBoxServices, AboutBoxServices) then
    AboutBoxIndex := AboutBoxServices.AddPluginInfo(resAboutTitle, resAboutCopyright + #13#10#13#10 + resAboutDescription, LoadBitmap(HInstance, ICON_ABOUT), False, resLicense);
end;

procedure UnregisterAboutBox;
begin
  if (AboutBoxIndex <> 0) and Assigned(AboutBoxServices) then
  begin
    AboutBoxServices.RemovePluginInfo(AboutBoxIndex);
    AboutBoxIndex := 0;
    AboutBoxServices := nil;
  end;
end;

initialization
  RegisterAboutBox;
  RegisterSplashScreen;

finalization
  UnRegisterAboutBox;

end.

Agora sim, este arquivo tem bem mais coisas a serem explicadas. Para começar, a linha 7 mostra uma referência a um arquivo .res que tem o mesmo nome do arquivo fonte com extensão trocada, ou seja, ZOOW.Wizards.Information.res. Este arquivo encontra-se na pasta res do código-fonte anexado a este artigo. É natural que precisemos de um arquivo de recurso, pois precisaremos vincular imagens ao BPL que será gerado, de forma que o OTA possa carrega-las e exibi-las.

Está gostando do que está lendo? Ajude nosso site visitando nossos patrocinadores. Obrigado! :)

Nas linhas 13 e 14 são definidas constantes de escopo local que contém os nomes dos recursos de imagem contidos no arquivo de recurso. Estas constantes foram definidas apenas para facilitar o acesso aos nomes SPLASHICON e ABOUTICON, os quais nomeiam as imagens no arquivo arquivo de recurso, cujo conteúdo pode ser visto na figura abaixo:

O ícone a ser exibido na tela de Splash precisa ter 24 x 24 pixels, enquanto o ícone a ser exibido na tela About, precisa ter 48 x 48 pixels. Na figura acima, o ícone da tela de About está selecionado e podemos ver suas dimensões, bem como a profundidade de cores na parte inferior da tela.

Voltando à explicação do arquivo ZOOW.Wizards.Information.pas, as linhas 17 e 18 definem algumas variáveis de escopo local necessárias apenas para a inclusão do ícone + informações na tela de About. Note que, pela primeira vez, você vê um identificador que contém a siga OTA, a interface IOTAAboutBoxServices. Como o próprio nome sugere, esta interface possui métodos que possibilitam a interação com a caixa de diálogo "Sobre" do Delphi.

As linhas 21 a 30 definem algumas Resource Strings (Strings de Recurso). Estas strings serão salvas no arquivo de recurso do projeto (arquivo .res com o mesmo nome do projeto .dpk), e consequentemente no BPL final gerado. O resultado disso pode ser visto, inspecionando-se o BPL final com um editor de recuso:

Note que o BPL final vai conter tanto nossas strings, como os ícones que foram incluídos no arquivo de recurso ZOOW.Wizards.Information.res. Isso é absolutamente esperado, já que todos os arquivos de recurso associados aos projetos delphi (dpr ou dpk) são incluídos nos binários gerados (dll, exe, bpl, etc.). Eu poderia ter usado simples constantes, mas resolvi usar strings de recurso, devido à sua flexibilidade. Se algum dos textos precisar de modificação eu posso alterar as strings usando um editor de recurso sem precisar recompilar o BPL. O mesmo acontece com os ícones, isto é, eu poderia alterar os ícones diretamente no BPL usando um editor de recurso, sem precisar recompilar o pacote!

As linhas 32 a 35 do arquivo ZOOW.Wizards.Information.pas definem o procedure RegisterSplashScreen. O método SplashScreenServices.AddPluginBitmap vai, de fato, incluir nosso ícone na tela de Splash do Delphi. Note que eu estou usando algumas das strings de recurso definidas anteriormente. Note também que eu estou carregando o ícone que deverá aparecer. LoadBitmap(HInstance,ICON_SPLASH) vai carregar diretamente do BPL (HInstance2) o recurso de imagem (bitmap) definido na constante ICON_SPLASH.

As linhas 37 a 41 definem o procedure RegisterAboutBox. De forma análoga ao procedure RegisterSplashScreen, este procedure vai habilitar a visualização de nosso ícone e de algumas informações na tela About do Delphi. Diferentemente do procedure anterior, este procedure precisa verificar se a interface IOTAAboutBoxServices é suportada por BorlandIDEServices e, caso seja, a variável AboutBoxServices conterá uma interface que permitirá a interação com a tela de About. AboutBoxServices.AddPluginInfo é a função que vai incluir nosso ícone e os textos na tela de About. Note que estou usando as strings de recurso e que também estou carregando o ícone que deve aparecer (LoadBitmap(HInstance,ICON_ABOUT). A função AboutBoxServices.AddPluginInfo retorna um número, um índice que representa este item na lista de "plugins" cujas informações são exibidas na tela de About.

As linhas 43 a 51 definem o procedure UnRegisterAboutBox. Este procedure é responsável por desregistrar (remover) nosso ícone e textos da tela de About. O código é bem simples e intuitivo. Não vou explicar.

As linhas 54 e 55, dentro da seção initialization, registram respectivamente os itens que serão exibidos na tela de Splash e os itens que serão exibidos na tela de About. Toda vez que nosso pacote for carregado pelo Delphi a seção de inicialização será executada, portanto, o registro de nossos itens especiais será realizado no momento em que o BPL for carregado pelo Delphi.

Por fim, a linha 58 mostra o que deve ser feito quando nosso pacote for descarregado (seção finalization). A única coisa sendo feita é o desregistro (remoção) dos itens da tela de About3.

Está gostando do que está lendo? Ajude nosso site visitando nossos patrocinadores. Obrigado! :)

Um pouco de ação

Agora que você entendeu o que está sendo feito, instale o pacote zoow (anexado a este artigo). Abra no Delphi o arquivo prj\Delphi 19 (Delphi XE5)\zoow.dpk4. Dê um build, depois um install. Se tudo ocorrer dentro do previsto e o pacote for instalado com sucesso, você já poderá, imediatamente, ir no menu Help > About Embarcadero Delphi (ou Help > About, não importa) e lá você já poderá ver o seu ícone e as informações que foram definidas no arquivo ZOOW.Wizards.Information.pas.

Para ver o ícone da tela de Splash, feche o Delphi e reabra. Seu ícone, bem como as informações definidas no arquivo ZOOW.Wizards.Information.pas deverão aparecer.


Um TForm modelo com propriedades especiais

O OTA não se limita apenas a permitir a colocação de simples ícones nas telas do Delphi. Nesta parte do artigo eu vou mostrar um uso bem mais útil desta arquitetura, o qual você pode usar para criar formulários básicos com funções e código-fonte personalizados, além de propriedades adicionais acessíveis diretamente no Object Inspector, as quais podem garantir um ganho de produtividade considerável. Não vou me ater a detalhes tal como "como criar os ícones", porque o artigo possui código-fonte anexado e você poderá entender melhor estudando-o e modificando-o como quiser.

Todas as vantagens de nosso TForm personalizado não são de graça! Para que você possa construir um formulário básico personalizado, uma série de arquivos adicionais precisam estar presentes no pacote sendo instalado. Vou listar primeiramente os arquivos estáticos e descrever brevemente para que eles servem. Eu os chamo de arquivos estáticos porque eles serão apenas utilizados, não precisarão ser modificados.

Por fim, os dois últimos arquivo listados serão "dinâmicos", pois neles o programador terá toda liberdade para realizar as alterações que bem entender a fim de adequar o wizard as suas necessidades, tanto de código-fonte e comportamento, como de informações visualizáveis nas telas do Delphi.

ZOOW.Wizards.Base.pas

unit ZOOW.Wizards.Base;

interface

{$I ..\Compilers.inc}

uses ToolsApi
   , Windows;

type
  TZOOWWizard = class(TNotifierObject
                     ,IOTAWizard
                     ,IOTARepositoryWizard
                     {$IFDEF COMPILER_6_UP},IOTARepositoryWizard60{$ENDIF}
                     {$IFDEF COMPILER_8_UP},IOTARepositoryWizard80{$ENDIF}
                     ,IOTAFormWizard)
  protected
    // IOTAWizard
    function GetIDString: string; virtual; abstract;
    function GetName: string; virtual; abstract;
    function GetState: TWizardState; virtual;
    procedure Execute; virtual; abstract;

    // IOTARepositoryWizard
    function GetAuthor: string; virtual;
    function GetComment: string; virtual;
    function GetPage: string; virtual; abstract;
    function GetGlyph: Cardinal; virtual;

    // IOTARepositoryWizard60
    function GetDesigner: string; virtual;
    property Designer: string read GetDesigner;

    // IOTARepositoryWizard80
    function GetGalleryCategory: IOTAGalleryCategory; virtual; abstract;
    function GetPersonality: string; virtual;
    property GalleryCategory: IOTAGalleryCategory read GetGalleryCategory;
    property Personality: string read GetPersonality;
  end;

implementation

{$R ..\..\res\ZOOW.Wizards.Images.res}

{ TZTOWizard }

function TZOOWWizard.GetAuthor: string;
begin
  Result := 'Zetta-Ømnis Soluções Tecnológicas Ltda. / Carlos Barreto Feitoza Filho';
end;

function TZOOWWizard.GetComment: string;
begin
  Result := 'Zetta-Ømnis Base Wizard';
end;

function TZOOWWizard.GetDesigner: string;
begin
  Result := dVCL;
end;

function TZOOWWizard.GetPersonality: string;
begin
  Result := sDelphiPersonality; 
end;

function TZOOWWizard.GetGlyph: Cardinal;
begin
  Result := 0;
end;

function TZOOWWizard.GetState: TWizardState;
begin
  Result := [];
end;

end.

Esta unit estática contém a classe básica da qual todos os nossos wizards herdarão. Ela implementa várias interfaces necessárias e define por padrão alguns métodos "get" a fim de definir o funcionamento básico de todos os wizards. Existem várias formas de implementar esta classe básica. A forma apresentada aqui permite criar TForms, TFrames e TDataModules especiais.

Está gostando do que está lendo? Ajude nosso site visitando nossos patrocinadores. Obrigado! :)

ZOOW.Lib.ToolsAPI.OTA.Utilities.pas

unit ZOOW.Lib.ToolsAPI.OTA.Utilities;

interface

uses
  Windows, ToolsAPI;

function GetCurrentProject: IOTAProject;
function GetCurrentProjectGroup: IOTAProjectGroup;
function ModuleIsForm(Module: IOTAModule): Boolean;
function ModuleIsProject(Module: IOTAModule): Boolean;
function ModuleIsProjectGroup(Module: IOTAModule): Boolean;
function ModuleIsTypeLib(Module: IOTAModule): Boolean;
function EditorIsFormEditor(Editor: IOTAEditor): Boolean;
function EditorIsProjectResEditor(Editor: IOTAEditor): Boolean;
function EditorIsTypeLibEditor(Editor: IOTAEditor): Boolean;
function EditorIsSourceEditor(Editor: IOTAEditor): Boolean;
function IsModule(Unk: IUnknown): Boolean;

implementation

function GetCurrentProject: IOTAProject;
var
  ProjectGroup: IOTAProjectGroup;
begin
  Result := nil;
  ProjectGroup := GetCurrentProjectGroup;

  if Assigned(ProjectGroup) then
    if ProjectGroup.ProjectCount > 0 then
      Result := ProjectGroup.ActiveProject
end;

function GetCurrentProjectGroup: IOTAProjectGroup;
var
  IModuleServices: IOTAModuleServices;
  IModule: IOTAModule;
  IProjectGroup: IOTAProjectGroup;
  i: Integer;
begin
  Result := nil;
  IModuleServices := BorlandIDEServices as IOTAModuleServices;
  for i := 0 to IModuleServices.ModuleCount - 1 do
  begin
    IModule := IModuleServices.Modules[i];
    if IModule.QueryInterface(IOTAProjectGroup, IProjectGroup) = S_OK then
    begin
      Result := IProjectGroup;
      Break;
    end;
  end;
end;

function ModuleIsForm(Module: IOTAModule): Boolean;
var
  i: Integer;
  FormEdit: IOTAFormEditor;
begin
  Result := False;
  if Assigned(Module) then
  begin
    // Form Module will have a DFM and a PAS file associated with it
    if Module.GetModuleFileCount > 1 then
    begin
      i := 0;
      // See if one of the Editors is a FormEditor
      while (i < Module.GetModuleFileCount) and not Result do
      begin
{$IFDEF COMPILER_6_UP}
        Result := Succeeded(Module.ModuleFileEditors[i].QueryInterface
          (IOTAFormEditor, FormEdit));
{$ELSE}
        Result := Succeeded(Module.GetModuleFileEditor(i)
          .QueryInterface(IOTAFormEditor, FormEdit));
{$ENDIF}
        Inc(i);
      end
    end
  end
end;

function ModuleIsProject(Module: IOTAModule): Boolean;
var
  Project: IOTAProject;
begin
  Result := False;
  if Assigned(Module) then
    Result := Succeeded(Module.QueryInterface(IOTAProject, Project))
end;

function ModuleIsProjectGroup(Module: IOTAModule): Boolean;
var
  ProjectGroup: IOTAProjectGroup;
begin
  Result := False;
  if Assigned(Module) then
    Result := Succeeded(Module.QueryInterface(IOTAProjectGroup, ProjectGroup))
end;

function ModuleIsTypeLib(Module: IOTAModule): Boolean;
var
  TypeLib: IOTATypeLibModule;
begin
  Result := False;
  if Assigned(Module) then
    Result := Succeeded(Module.QueryInterface(IOTATypeLibModule, TypeLib))
end;

function EditorIsFormEditor(Editor: IOTAEditor): Boolean;
var
  FormEdit: IOTAFormEditor;
begin
  Result := False;
  if Assigned(Editor) then
    Result := Succeeded(Editor.QueryInterface(IOTAFormEditor, FormEdit))
end;

function EditorIsProjectResEditor(Editor: IOTAEditor): Boolean;
var
  ProjRes: IOTAProjectResource;
begin
  Result := False;
  if Assigned(Editor) then
    Result := Succeeded(Editor.QueryInterface(IOTAProjectResource, ProjRes))
end;

function EditorIsTypeLibEditor(Editor: IOTAEditor): Boolean;
var
  TypeLib: IOTATypeLibEditor;
begin
  Result := False;
  if Assigned(Editor) then
    Result := Succeeded(Editor.QueryInterface(IOTATypeLibEditor, TypeLib))
end;

function EditorIsSourceEditor(Editor: IOTAEditor): Boolean;
var
  SourceEdit: IOTASourceEditor;
begin
  Result := False;
  if Assigned(Editor) then
    Result := Succeeded(Editor.QueryInterface(IOTASourceEditor, SourceEdit))
end;

function IsModule(Unk: IUnknown): Boolean;
var
  Module: IOTAModule;
begin
  Result := False;
  if Assigned(Unk) then
    Result := Succeeded(Unk.QueryInterface(IOTAModule, Module))
end;

end.

Esta unit estática contém várias funções utilitárias que são usadas pelos "Criadores OTA", explicados na seção a seguir.

Está gostando do que está lendo? Ajude nosso site visitando nossos patrocinadores. Obrigado! :)

ZOOW.Lib.ToolsAPI.OTA.Creators.pas

unit ZOOW.Lib.ToolsAPI.OTA.Creators;

interface

{$I ..\Compilers.inc}

uses
  Windows, SysUtils, ZOOW.Lib.ToolsAPI.OTA.Utilities, ToolsAPI;

type
  //
  // Implements a basic IOTAFile
  //
  TBaseCreatorFile = class(TInterfacedObject, IOTAFile)
  private
    FAge: TDateTime;
  public
    constructor Create;
    function GetSource: string; virtual;
    function GetAge: TDateTime;
  end;

  //
  // Implements IOTAFile for the TBaseFormCreatorModule to create
  // a Form
  //
  TModuleCreatorFile = class(TBaseCreatorFile)
  private
    FModuleIdent: String;
    FFormIdent: String;
    FAncestorIdent: string;
  public
    constructor Create(const ModuleIdent, FormIdent, AncestorIdent: string);
    function GetSource: String; override;
  end;

  TModuleCreatorFileClass = class of TModuleCreatorFile;

  //
  // Implements IOTACreator and IOTAModuleCreator for Module creation
  //
  TBaseCreatorModule = class(TInterfacedObject, IOTACreator, IOTAModuleCreator)
  public
    // IOTACreator
    function GetCreatorType: string; virtual; abstract;
    function GetExisting: Boolean;
    function GetFileSystem: string;
    function GetOwner: IOTAModule;
    function GetUnnamed: Boolean;

    // IOTAModuleCreator
    function GetAncestorName: string; virtual;
    function GetImplFileName: string;
    function GetIntfFileName: string;
    function GetFormName: string; virtual;
    function GetMainForm: Boolean;
    function GetShowForm: Boolean;
    function GetShowSource: Boolean;
    function NewFormFile(const FormIdent, AncestorIdent: string): IOTAFile;
    function NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string)
      : IOTAFile; virtual;
    function NewIntfSource(const ModuleIdent, FormIdent, AncestorIdent: string)
      : IOTAFile; virtual;
    procedure FormCreated(const FormEditor: IOTAFormEditor);

    function GetImplFile: TModuleCreatorFileClass; virtual;
    function GetIntfFile: TModuleCreatorFileClass; virtual;

    property AncestorName: string read GetAncestorName;
    property FormName: string read GetFormName;
    property ImplFileName: string read GetImplFileName;
    property IntfFileName: string read GetIntfFileName;
    property MainForm: Boolean read GetMainForm;
    property ShowForm: Boolean read GetShowForm;
    property ShowSource: Boolean read GetShowSource;
  end;

  //
  // Implements a specialized Form Module
  //
  TFormCreatorModule = class(TBaseCreatorModule)
  public
    function GetCreatorType: string; override;
    function GetAncestorName: string; override;
  end;

  //
  // Implements a specialized DataModule Module
  //
  TDataModuleCreatorModule = class(TBaseCreatorModule)
  public
    function GetAncestorName: string; override;
  end;

  //
  // Implements a specialized Frame Module
  //
  TFrameCreatorModule = class(TBaseCreatorModule)
    function GetAncestorName: string; override;
  end;

{$IFDEF COMPILER_8_UP}

  // These must be called in the initialization section of a unit
function AddDelphiCategory(CategoryID, CategoryCaption: string)
  : IOTAGalleryCategory;
function AddBuilderCategory(CategoryID, CategoryCaption: string)
  : IOTAGalleryCategory;
procedure RemoveCategory(Category: IOTAGalleryCategory);
{$ENDIF COMPILER_8_UP}

implementation

{$IFDEF COMPILER_8_UP}

function AddDelphiCategory(CategoryID, CategoryCaption: string)
  : IOTAGalleryCategory;
var
  Manager: IOTAGalleryCategoryManager;
  ParentCategory: IOTAGalleryCategory;
begin
  Result := nil;
  Manager := BorlandIDEServices as IOTAGalleryCategoryManager;

  if Assigned(Manager) then
  begin
    ParentCategory := Manager.FindCategory(sCategoryDelphiNew);
    if Assigned(ParentCategory) then
      Result := Manager.AddCategory(ParentCategory, CategoryID,
        CategoryCaption);
  end;
end;

function AddBuilderCategory(CategoryID, CategoryCaption: string)
  : IOTAGalleryCategory;
var
  Manager: IOTAGalleryCategoryManager;
  ParentCategory: IOTAGalleryCategory;
begin
  Result := nil;
  Manager := BorlandIDEServices as IOTAGalleryCategoryManager;
  if Assigned(Manager) then
  begin
    ParentCategory := Manager.FindCategory(sCategoryCBuilderNew);
    if Assigned(ParentCategory) then
      Result := Manager.AddCategory(ParentCategory, CategoryID,
        CategoryCaption);
  end
end;

procedure RemoveCategory(Category: IOTAGalleryCategory);
var
  Manager: IOTAGalleryCategoryManager;
begin
  Manager := BorlandIDEServices as IOTAGalleryCategoryManager;
  if Assigned(Manager) then
  begin
    if Assigned(Category) then
      Manager.DeleteCategory(Category)
  end
end;
{$ENDIF COMPILER_8_UP}

{ TBaseCreatorFile }
constructor TBaseCreatorFile.Create;
begin
  FAge := -1; // Flag age as New File
end;

function TBaseCreatorFile.GetAge: TDateTime;
begin
  Result := FAge
end;

function TBaseCreatorFile.GetSource: string;
begin
  Result := ''
end;

{ TModuleCreatorFile }

constructor TModuleCreatorFile.Create(const ModuleIdent, FormIdent,
  AncestorIdent: string);
begin
  FAge := -1; // Flag age as New File
  FModuleIdent := ModuleIdent;
  FFormIdent := FormIdent;
  FAncestorIdent := AncestorIdent;
end;

function TModuleCreatorFile.GetSource: String;
begin
  // Parameterize the code with the current Identifiers
  if FModuleIdent <> '' then
    Result := StringReplace(Result, '<UNITNAME>', FModuleIdent,
      [rfReplaceAll, rfIgnoreCase]);
  if FFormIdent <> '' then
    Result := StringReplace(Result, '<CLASS_ID>', FFormIdent,
      [rfReplaceAll, rfIgnoreCase]);
  if FAncestorIdent <> '' then
    Result := StringReplace(Result, '<ANCESTOR_ID>', FAncestorIdent,
      [rfReplaceAll, rfIgnoreCase]);
end;

{ TBaseCreatorModule }

procedure TBaseCreatorModule.FormCreated(const FormEditor: IOTAFormEditor);
begin

end;

function TBaseCreatorModule.GetAncestorName: string;
begin
  Result := '';
end;

function TBaseCreatorModule.GetExisting: Boolean;
begin
  Result := False; // Create a new module
end;

function TBaseCreatorModule.GetFileSystem: string;
begin
  Result := ''; // Default File System
end;

function TBaseCreatorModule.GetFormName: string;
begin
  Result := '';
end;

function TBaseCreatorModule.GetImplFile: TModuleCreatorFileClass;
begin
  Result := TModuleCreatorFile;
end;

function TBaseCreatorModule.GetImplFileName: string;
begin
  Result := '';
end;

function TBaseCreatorModule.GetIntfFileName: string;
begin
  Result := '';
end;

function TBaseCreatorModule.GetIntfFile: TModuleCreatorFileClass;
begin
  Result := TModuleCreatorFile;
end;

function TBaseCreatorModule.GetMainForm: Boolean;
begin
  Result := True;
end;

function TBaseCreatorModule.GetOwner: IOTAModule;
begin
  Result := GetCurrentProject; // Owned by current project
end;

function TBaseCreatorModule.GetShowForm: Boolean;
begin
  Result := True;
end;

function TBaseCreatorModule.GetShowSource: Boolean;
begin
  Result := True;
end;

function TBaseCreatorModule.GetUnnamed: Boolean;
begin
  Result := True; // Project needs to be named/saved
end;

function TBaseCreatorModule.NewFormFile(const FormIdent, AncestorIdent: string)
  : IOTAFile;
begin
  Result := nil;
end;

function TBaseCreatorModule.NewImplSource(const ModuleIdent, FormIdent,
  AncestorIdent: string): IOTAFile;
begin
  Result := nil;
  if GetImplFile <> nil then
    Result := GetImplFile.Create(ModuleIdent, FormIdent, AncestorIdent);
end;

function TBaseCreatorModule.NewIntfSource(const ModuleIdent, FormIdent,
  AncestorIdent: string): IOTAFile;
begin
  Result := nil;
  if GetIntfFile <> nil then
    Result := GetIntfFile.Create(ModuleIdent, FormIdent, AncestorIdent);
end;

{ TFormCreatorModule }

function TFormCreatorModule.GetAncestorName: string;
begin
  Result := 'TForm'
end;

function TFormCreatorModule.GetCreatorType: string;
begin
  Result := sForm
end;

{ TDataModuleCreatorModule }

function TDataModuleCreatorModule.GetAncestorName: string;
begin
  Result := 'TDataModule'
end;

{ TFrameCreatorModule }

function TFrameCreatorModule.GetAncestorName: string;
begin
  Result := 'TFrame'
end;

end.

Esta unit estática é responsável por definir as classes básicas que implementam as interfaces IOTAModuleCreator, IOTACreator e IOTAFile. Conhecidas como "Criadores OTA", as classes que implementam estas interfaces são usadas internamente pelo Delphi para criar os módulos (TForms, TFrames e TDataModules) e seus arquivos-fonte correspondentes, incluindo seus arquivos .dfm, quando aplicável.

Dentro desta unit, merece menção o método TModuleCreatorFile.GetSource (linhas 191 a 203), o qual é uma função que deve retornar o código fonte de um módulo. Note que existem alguns "tags" básicos sendo substituídos. Estes tags precisam estar obrigatoriamente presentes no modelo de código-fonte, o qual será definido na unit dinâmica específica do wizard, a qual será explicada a seguir.

Está gostando do que está lendo? Ajude nosso site visitando nossos patrocinadores. Obrigado! :)

ZOOW.Wizards.Form.Wizard.pas

unit ZOOW.Wizards.Form.Wizard;

interface

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

type
  TZOOWFormWizard = 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;

  TZOOWFormFileCreator = class(TModuleCreatorFile)
  public
    function GetSource: string; override;
  end;

  TZOOWFormModuleCreator = 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.FORM'; { EMPRESA.PRODUTO.TIPO.NOME }
  WIZARD_NAME = 'Zetta-Ømnis Form';
  WIZARD_COMMENT = 'Form com opções avançadas adicionais. Este form também po' +
  'de ser usado em conjunto com o Zetta-Ømnis DataModule, sendo criado por es' +
  'te último automaticamente mediante a informação de sua classe no object in' +
  'spector';
  WIZARD_ICONS = 'ZOOW_FORM_ICONS';
  { As duas constantes a seguir são substituídas dentro da constante
  FILE_CONTENT }
  DEFINITIONUNIT = 'ZOOW.Wizards.Form';
  ANCESTOR_ID = 'ZOOWForm'; { Sem o "T" inicial }

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

  '{ Zetta-Ømnis Form. 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 +

  'initialization'#13#10 +
  '  RegisterClass(T<CLASS_ID>)'#13#10#13#10 +

  'end.';

var
  DelphiCategory: IOTAGalleryCategory;

{ TZOOWFormModuleCreator }

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

function TZOOWFormModuleCreator.GetImplFile: TModuleCreatorFileClass;
begin
  Result := TZOOWFormFileCreator;
end;

{ TZOOWFormFileCreator }

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

{ TZOOWFormWizard }

procedure TZOOWFormWizard.Execute;
begin
  inherited;
  (BorlandIDEServices as IOTAModuleServices).CreateModule(TZOOWFormModuleCreator.Create);
end;

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

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

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

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

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

function TZOOWFormWizard.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 dinâmica define nosso wizard, um wizard de um TForm personalizado. Note que há a definição do código fonte inicial que nosso TForm terá, e esta definição está sendo armazenada na constante FILE_CONTENT (linhas 63 a 91). Note que o texto desse arquivo fonte que será gerado contém os tags substituíveis requeridos e que são substituídos no método TModuleCreatorFile.GetSource de ZOOW.Lib.ToolsAPI.OTA.Creators.pas.

Está gostando do que está lendo? Ajude nosso site visitando nossos patrocinadores. Obrigado! :)

Além dos três tags requeridos, eu incluí mais dois tags a fim de exemplificar como a criação do fonte pode ser dinâmica. Os tags adicionais são <DEFINITIONUNIT><COPYRIGHTYEAR> (linhas 60 a 61). Ambos estes tags serão substituídos no método TZOOWFormFileCreator.GetSource (linhas 110 a 115).

<DEFINITIONUNIT> será substituído pela constante contendo o nome da unit que contém a classe de nosso TForm personalizado (veja a próxima seção). Já <COPYRIGHTYEAR> será meramente substituído por uma string contendo o ano atual, uma barra e o ano subsequente, e está sendo usado para compor uma pequena informação de copyright no topo da unit que será gerada. Observe que na linha 114 estamos executando o método da classe base. Será esta execução a responsável por substituir os três tags obrigatórios. inherited GetSource executa o método TModuleCreatorFile.GetSource de ZOOW.Lib.ToolsAPI.OTA.Creators.pas.

As outras constantes definem nomes, identificadores únicos, identificadores de ícones e a descrição de nosso wizard. Tanto o ícone, como parte desta informação poderá ser visualizada na tela "New Items" do Delphi (File > New > Other...), veja:

ZOOW.Wizards.Form.pas

unit ZOOW.Wizards.Form;

interface

uses Forms, Classes, Controls, Buttons, Graphics, ExtCtrls;

type
  TVisibleButton = (vbOk,vbYes,vbYesToAll,vbNo,vbIgnore,vbCancel,vbClose,vbHelp);
  TVisibleButtons = set of TVisibleButton;

  TDisabledButton = (dbOk,dbYes,dbYesToAll,dbNo,dbIgnore,dbCancel,dbClose,dbHelp);
  TDisabledButtons = set of TDisabledButton;

  TSelectedButton = (sbNone,sbOk,sbYes,sbYesToAll,sbNo,sbIgnore,sbCancel,sbClose,sbHelp);

  TButtonsPanel = class(TPersistent)
  private
    FPANEButtons: TPanel;
    FBBTNOK: TBitBtn;
    FBBTNCancel: TBitBtn;
    FVisibleButtons: TVisibleButtons;
    FDisabledButtons: TDisabledButtons;
    FBBTNYes: TBitBtn;
    FBBTNYesToAll: TBitBtn;
    FBBTNNo: TBitBtn;
    FBBTNIgnore: TBitBtn;
    FBBTNClose: TBitBtn;
    FBBTNHelp: TBitBtn;
    FSelectedButton: TSelectedButton;
    function GetVisible: Boolean;
    procedure SetVisible(const aValue: Boolean);
    procedure SetDisabledButtons(const Value: TDisabledButtons);
    procedure SetVisibleButtons(const Value: TVisibleButtons);
    procedure SetSelectedButton(const Value: TSelectedButton);
    procedure SetParent(const Value: TWinControl);
    function GetParent: TWinControl;
  public
    constructor Create;
    destructor Destroy; override;
    property Parent: TWinControl read GetParent write SetParent;
  published
    property Visible: Boolean read GetVisible write SetVisible default False;
    property VisibleButtons: TVisibleButtons read FVisibleButtons write SetVisibleButtons default [vbOk];
    property DisabledButtons: TDisabledButtons read FDisabledButtons write SetDisabledButtons default [];
    property SelectedButton: TSelectedButton read FSelectedButton write SetSelectedButton default sbOK;
  end;

  { Novos Forms precisam ser herdados de TForm e não de TCustomForm porque
  apenas os descendentes de TForm são incluídos na lista de forms de tela no
  objeto TScreen, não sei se é um bug, mas é assim }
  TZOOWForm = class(TForm)
  private
    FButtonsPanel: TButtonsPanel;
    function GetOnCancelButtonClick: TNotifyEvent;
    function GetOnCloseButtonClick: TNotifyEvent;
    function GetOnHelpButtonClick: TNotifyEvent;
    function GetOnIgnoreButtonClick: TNotifyEvent;
    function GetOnNoButtonClick: TNotifyEvent;
    function GetOnOkButtonClick: TNotifyEvent;
    function GetOnYesButtonClick: TNotifyEvent;
    function GetOnYesToAllButtonClick: TNotifyEvent;
    procedure SetOnCancelButtonClick(const Value: TNotifyEvent);
    procedure SetOnCloseButtonClick(const Value: TNotifyEvent);
    procedure SetOnHelpButtonClick(const Value: TNotifyEvent);
    procedure SetOnIgnoreButtonClick(const Value: TNotifyEvent);
    procedure SetOnNoButtonClick(const Value: TNotifyEvent);
    procedure SetOnOkButtonClick(const Value: TNotifyEvent);
    procedure SetOnYesButtonClick(const Value: TNotifyEvent);
    procedure SetOnYesToAllButtonClick(const Value: TNotifyEvent);
  protected
    procedure DoClose(var Action: TCloseAction); override;
    procedure DoShow; override;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ButtonsPanel: TButtonsPanel read FButtonsPanel write FButtonsPanel;

    property OnOkButtonClick: TNotifyEvent read GetOnOkButtonClick write SetOnOkButtonClick;
    property OnCancelButtonClick: TNotifyEvent read GetOnCancelButtonClick write SetOnCancelButtonClick;
    property OnYesButtonClick: TNotifyEvent read GetOnYesButtonClick write SetOnYesButtonClick;
    property OnYesToAllButtonClick: TNotifyEvent read GetOnYesToAllButtonClick write SetOnYesToAllButtonClick;
    property OnNoButtonClick: TNotifyEvent read GetOnNoButtonClick write SetOnNoButtonClick;
    property OnIgnoreButtonClick: TNotifyEvent read GetOnIgnoreButtonClick write SetOnIgnoreButtonClick;
    property OnCloseButtonClick: TNotifyEvent read GetOnCloseButtonClick write SetOnCloseButtonClick;
    property OnHelpButtonClick: TNotifyEvent read GetOnHelpButtonClick write SetOnHelpButtonClick;
  end;

  TZOOWFormClass = class of TZOOWForm;

implementation

uses Messages;

{ TZOOWCustomForm }

constructor TZOOWForm.Create(aOwner: TComponent);
begin
  FButtonsPanel := TButtonsPanel.Create;
  inherited;
  FButtonsPanel.Parent := Self;
end;

destructor TZOOWForm.Destroy;
begin
  FButtonsPanel.Free;
  inherited;
end;

procedure TZOOWForm.DoClose(var Action: TCloseAction);
begin
  inherited;

end;

procedure TZOOWForm.DoShow;
begin
  inherited;
  FButtonsPanel.SetSelectedButton(FButtonsPanel.FSelectedButton);
end;

function TZOOWForm.GetOnCancelButtonClick: TNotifyEvent;
begin
  Result := FButtonsPanel.FBBTNCancel.OnClick;
end;

function TZOOWForm.GetOnCloseButtonClick: TNotifyEvent;
begin
  Result := FButtonsPanel.FBBTNClose.OnClick;
end;

function TZOOWForm.GetOnHelpButtonClick: TNotifyEvent;
begin
  Result := FButtonsPanel.FBBTNHelp.OnClick;
end;

function TZOOWForm.GetOnIgnoreButtonClick: TNotifyEvent;
begin
  Result := FButtonsPanel.FBBTNIgnore.OnClick;
end;

function TZOOWForm.GetOnNoButtonClick: TNotifyEvent;
begin
  Result := FButtonsPanel.FBBTNNo.OnClick;
end;

function TZOOWForm.GetOnOkButtonClick: TNotifyEvent;
begin
  Result := FButtonsPanel.FBBTNOK.OnClick;
end;

function TZOOWForm.GetOnYesButtonClick: TNotifyEvent;
begin
  Result := FButtonsPanel.FBBTNYes.OnClick;
end;

function TZOOWForm.GetOnYesToAllButtonClick: TNotifyEvent;
begin
  Result := FButtonsPanel.FBBTNYesToAll.OnClick;
end;

procedure TZOOWForm.SetOnCancelButtonClick(const Value: TNotifyEvent);
begin
  FButtonsPanel.FBBTNCancel.OnClick := Value;
end;

procedure TZOOWForm.SetOnCloseButtonClick(const Value: TNotifyEvent);
begin
  FButtonsPanel.FBBTNClose.OnClick := Value;
end;

procedure TZOOWForm.SetOnHelpButtonClick(const Value: TNotifyEvent);
begin
  FButtonsPanel.FBBTNHelp.OnClick := Value;
end;

procedure TZOOWForm.SetOnIgnoreButtonClick(const Value: TNotifyEvent);
begin
  FButtonsPanel.FBBTNIgnore.OnClick := Value;
end;

procedure TZOOWForm.SetOnNoButtonClick(const Value: TNotifyEvent);
begin
  FButtonsPanel.FBBTNNo.OnClick := Value;
end;

procedure TZOOWForm.SetOnOkButtonClick(const Value: TNotifyEvent);
begin
  FButtonsPanel.FBBTNOK.OnClick := Value;
end;

procedure TZOOWForm.SetOnYesButtonClick(const Value: TNotifyEvent);
begin
  FButtonsPanel.FBBTNYes.OnClick := Value;
end;

procedure TZOOWForm.SetOnYesToAllButtonClick(const Value: TNotifyEvent);
begin
  FButtonsPanel.FBBTNYesToAll.OnClick := Value;
end;

{ TButtonsPanel }

constructor TButtonsPanel.Create;
begin
  FSelectedButton := sbOK;
  FVisibleButtons := [vbOk];

  FPANEButtons := TPanel.Create(nil);
  FPANEButtons.Height := 39;
  FPANEButtons.Parent := nil;
  FPANEButtons.Align := alBottom;
  FPANEButtons.Visible := False;
  FPANEButtons.BevelEdges := [beTop,beBottom];
  FPANEButtons.Color := clInfoBk;
  FPANEButtons.ParentBackground := False;

  FBBTNOK := TBitBtn.Create(nil);
  FBBTNOK.Parent := FPANEButtons;
  FBBTNOK.Align := alRight;
  FBBTNOK.Margins.Right := 6;
  FBBTNOK.Margins.Top := 6;
  FBBTNOK.Margins.Bottom := 6;
  FBBTNOK.Margins.Left := 0;
  FBBTNOK.AlignWithMargins := True;
  FBBTNOK.Caption := 'OK';
  FBBTNOK.Left := 0;

  FBBTNYes := TBitBtn.Create(nil);
  FBBTNYes.Parent := FPANEButtons;
  FBBTNYes.Align := alRight;
  FBBTNYes.Margins.Right := 6;
  FBBTNYes.Margins.Top := 6;
  FBBTNYes.Margins.Bottom := 6;
  FBBTNYes.Margins.Left := 0;
  FBBTNYes.AlignWithMargins := True;
  FBBTNYes.Caption := 'Sim';
  FBBTNYes.Hide;
  FBBTNYes.Left := 0;

  FBBTNYesToAll := TBitBtn.Create(nil);
  FBBTNYesToAll.Parent := FPANEButtons;
  FBBTNYesToAll.Align := alRight;
  FBBTNYesToAll.Margins.Right := 6;
  FBBTNYesToAll.Margins.Top := 6;
  FBBTNYesToAll.Margins.Bottom := 6;
  FBBTNYesToAll.Margins.Left := 0;
  FBBTNYesToAll.AlignWithMargins := True;
  FBBTNYesToAll.Caption := 'Sim para tudo';
  FBBTNYesToAll.Hide;
  FBBTNYesToAll.Left := 0;

  FBBTNNo := TBitBtn.Create(nil);
  FBBTNNo.Parent := FPANEButtons;
  FBBTNNo.Align := alRight;
  FBBTNNo.Margins.Right := 6;
  FBBTNNo.Margins.Top := 6;
  FBBTNNo.Margins.Bottom := 6;
  FBBTNNo.Margins.Left := 0;
  FBBTNNo.AlignWithMargins := True;
  FBBTNNo.Caption := 'Não';
  FBBTNNo.Hide;
  FBBTNNo.Left := 0;

  FBBTNIgnore := TBitBtn.Create(nil);
  FBBTNIgnore.Parent := FPANEButtons;
  FBBTNIgnore.Align := alRight;
  FBBTNIgnore.Margins.Right := 6;
  FBBTNIgnore.Margins.Top := 6;
  FBBTNIgnore.Margins.Bottom := 6;
  FBBTNIgnore.Margins.Left := 0;
  FBBTNIgnore.AlignWithMargins := True;
  FBBTNIgnore.Caption := 'Ignorar';
  FBBTNIgnore.Hide;
  FBBTNIgnore.Left := 0;

  FBBTNCancel := TBitBtn.Create(nil);
  FBBTNCancel.Parent := FPANEButtons;
  FBBTNCancel.Align := alRight;
  FBBTNCancel.Margins.Right := 6;
  FBBTNCancel.Margins.Top := 6;
  FBBTNCancel.Margins.Bottom := 6;
  FBBTNCancel.Margins.Left := 0;
  FBBTNCancel.AlignWithMargins := True;
  FBBTNCancel.Caption := 'Cancelar';
  FBBTNCancel.Hide;
  FBBTNCancel.Left := 0;

  FBBTNClose := TBitBtn.Create(nil);
  FBBTNClose.Parent := FPANEButtons;
  FBBTNClose.Align := alRight;
  FBBTNClose.Margins.Right := 6;
  FBBTNClose.Margins.Top := 6;
  FBBTNClose.Margins.Bottom := 6;
  FBBTNClose.Margins.Left := 0;
  FBBTNClose.AlignWithMargins := True;
  FBBTNClose.Caption := 'Fechar';
  FBBTNClose.Hide;
  FBBTNClose.Left := 0;

  FBBTNHelp := TBitBtn.Create(nil);
  FBBTNHelp.Parent := FPANEButtons;
  FBBTNHelp.Align := alRight;
  FBBTNHelp.Margins.Right := 6;
  FBBTNHelp.Margins.Top := 6;
  FBBTNHelp.Margins.Bottom := 6;
  FBBTNHelp.Margins.Left := 0;
  FBBTNHelp.AlignWithMargins := True;
  FBBTNHelp.Caption := 'Ajuda';
  FBBTNHelp.Hide;
  FBBTNHelp.Left := 0;
end;

destructor TButtonsPanel.Destroy;
begin
  FBBTNHelp.Free;
  FBBTNClose.Free;
  FBBTNIgnore.Free;
  FBBTNNo.Free;
  FBBTNYesToAll.Free;
  FBBTNYes.Free;
  FBBTNCancel.Free;
  FBBTNOK.Free;
  FPANEButtons.Free;
  inherited;
end;

function TButtonsPanel.GetParent: TWinControl;
begin
  Result := FPANEButtons.Parent;
end;

function TButtonsPanel.GetVisible: Boolean;
begin
  Result := FPANEButtons.Visible;
end;

procedure TButtonsPanel.SetDisabledButtons(const Value: TDisabledButtons);
begin
  FDisabledButtons := Value;

  FBBTNOK.Enabled       := not (dbOk       in FDisabledButtons);
  FBBTNYes.Enabled      := not (dbYes      in FDisabledButtons);
  FBBTNYesToAll.Enabled := not (dbYesToAll in FDisabledButtons);
  FBBTNNo.Enabled       := not (dbNo       in FDisabledButtons);
  FBBTNIgnore.Enabled   := not (dbIgnore   in FDisabledButtons);
  FBBTNCancel.Enabled   := not (dbCancel   in FDisabledButtons);
  FBBTNClose.Enabled    := not (dbClose    in FDisabledButtons);
  FBBTNHelp.Enabled     := not (dbHelp     in FDisabledButtons);
end;

procedure TButtonsPanel.SetParent(const Value: TWinControl);
begin
  FPANEButtons.Parent := Value;
end;

procedure TButtonsPanel.SetSelectedButton(const Value: TSelectedButton);
begin
  FSelectedButton := Value;

  if (not Assigned(FPANEButtons.Parent)) or (csDesigning in FPANEButtons.Parent.ComponentState) then
    Exit;

  case FSelectedButton of
    sbOk: if FBBTNOK.Enabled and FBBTNOK.Showing then FBBTNOK.SetFocus;
    sbYes: if FBBTNYes.Enabled and FBBTNYes.Showing then FBBTNYes.SetFocus;
    sbYesToAll: if FBBTNYesToAll.Enabled and FBBTNYesToAll.Showing then FBBTNYesToAll.SetFocus;
    sbNo: if FBBTNNo.Enabled and FBBTNNo.Showing then FBBTNNo.SetFocus;
    sbIgnore: if FBBTNIgnore.Enabled and FBBTNIgnore.Showing then FBBTNIgnore.SetFocus;
    sbCancel: if FBBTNCancel.Enabled and FBBTNCancel.Showing then FBBTNCancel.SetFocus;
    sbClose: if FBBTNClose.Enabled and FBBTNClose.Showing then FBBTNClose.SetFocus;
    sbHelp: if FBBTNHelp.Enabled and FBBTNHelp.Showing then FBBTNHelp.SetFocus;
  end;
end;

procedure TButtonsPanel.SetVisible(const aValue: Boolean);
begin
  FPANEButtons.Visible := aValue;
end;

procedure TButtonsPanel.SetVisibleButtons(const Value: TVisibleButtons);
begin
  FVisibleButtons := Value;

  FBBTNOK.Visible := False;
  FBBTNYes.Visible := False;
  FBBTNYesToAll.Visible := False;
  FBBTNNo.Visible := False;
  FBBTNIgnore.Visible := False;
  FBBTNCancel.Visible := False;
  FBBTNClose.Visible := False;
  FBBTNHelp.Visible := False;

  FBBTNHelp.Visible     := vbHelp     in FVisibleButtons;
  FBBTNClose.Visible    := vbClose    in FVisibleButtons;
  FBBTNCancel.Visible   := vbCancel   in FVisibleButtons;
  FBBTNIgnore.Visible   := vbIgnore   in FVisibleButtons;
  FBBTNNo.Visible       := vbNo       in FVisibleButtons;
  FBBTNYesToAll.Visible := vbYesToAll in FVisibleButtons;
  FBBTNYes.Visible      := vbYes      in FVisibleButtons;
  FBBTNOK.Visible       := vbOk       in FVisibleButtons;
end;

end.

Esta unit contém o código-fonte de nosso TForm personalizado. Aqui só se vê código simples, nada de OTA e isso é esperado, pois esta é a unit que define apenas o nosso componente (Sim, o TForm pode ser considerado um componente nesse contexto), com seus métodos, suas propriedades e seus comportamentos esperados. É nesta unit, mais especificamente na classe de nosso TForm (TZOOWForm) onde nós vamos definir todas as nossas propriedades published, as quais aparecerão no Object Inspector, coisa que não era possível fazer simplesmente herdando de TForm em um pacote de componentes simples (sem usar OTA).

Está gostando do que está lendo? Ajude nosso site visitando nossos patrocinadores. Obrigado! :)

Eu não vou explicar como foram feitas as personalizações no TForm. Isso fica como desafio (ou não) para você, caro leitor. Não é nada complexo, mas é engenhoso, admito. Abra o projeto de exemplo no Delphi, instale o wizard (pacote bpl) e abra o demo. Verifique a unit UFormSecundario e explore a propriedade ButtonsPanel de TFormSecundario.

Apesar de, no arquivo anexo, eu estar dizendo que o componente é para Delphi XE5, ele pode ser instalado em outros Delphis, basta tentar. Acredito que o exemplo como um todo deva funcionar em Delphi 2006 ou superior com um mínimo de ajustes.

Abaixo está um exemplo de como o arquivo fonte vai ser criado, quando nosso wizard for selecionado:

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.

Compare este código-fonte com o conteúdo da constante FILE_CONTENT a fim de saber como foram feitas as substituições dos tags especiais.

Propositalmente em meus fontes eu não incluo uma variável global para o TForm, porque usá-la é uma má prática, no entanto você poderá alterar a constante FILE_CONTENT para que seu fonte já possua desde o começo esta variável global.

A imagem abaixo mostra o nosso TForm em tempo de projeto, bem como o Object Inspector e a nossa propriedade published ButtonsPanel, através da qual podemos exibir ou ocultar o painel de botões, bem como, ocultar ou exibir cada um dos botões disponíveis. A imagem foi obtida a partir do Delphi 2006, após a instalação do pacote que está anexado a este artigo.

Além dessas propriedades, também estão disponíveis eventos de clique exclusivos, um para cada botão, tornando fácil a manipulação dos cliques nos mesmos.


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!

Está gostando do que está lendo? Ajude nosso site visitando nossos patrocinadores. Obrigado! :)

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.

Está gostando do que está lendo? Ajude nosso site visitando nossos patrocinadores. Obrigado! :)

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.

Está gostando do que está lendo? Ajude nosso site visitando nossos patrocinadores. Obrigado! :)

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 :)

Está gostando do que está lendo? Ajude nosso site visitando nossos patrocinadores. Obrigado! :)
Arquivos anexados
ArquivoDescriçãoTamanhoModificado em
Download this file (zoow.zip)ZOOWExemplos de utilização básica do OTA (Mais Bonus Track)41 KB14/04/2017 às 15:45
e-max.it: your social media marketing partner
1http://docwiki.embarcadero.com/RADStudio/XE8/en/Extending_the_IDE_Using_the_Tools_API
2HInstance, refere-se à instância atual do nosso projeto após ser compilado. Como estamos compilando um pacote, que vai gerar um BPL, HInstance refere-se à instância do BPL carregado pelo Delphi
3As informações colocadas na tela de Splash não precisam ser removidas, na verdade, nem mesmo existe uma função para realizar esta operação ;)
4Este exemplo foi compilado originalmente em Delphi XE5, por isso a pasta com esse nome, contudo, ele também funciona em outros Delphis. Eu o testei em Delphi 2006, por exemplo, mas não posso garantir que vá funcionar sem alguma modificação. Isso fica como tarefa de casa pra você. Por se tratar de um componente, eu estou utilizando o LibSuffix de acordo com o Delphi XE5 (190). Se você for compilar em outro Delphi, é desejável usar o libsuffix correto. Apesar de isso não ser obrigatório, é uma boa prática colocar esta informação de acordo com o Delphi para o qual o pacote de componentes foi desenvolvido
Ajude nosso site visitando nossos patrocinadores!

Temos 49 visitantes e Nenhum membro online nos últimos 10 minutos (4.9 visitantes por minuto).