Open Tools API
Escrito por Carlos B. Feitoza Filho | |
Categoria: Artigos | |
Categoria Pai: Addicted 2 Delphi! | |
Acessos: 58957 |
Páginas dentro deste 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-Do[1].
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.
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.
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.
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 (HInstance[2]) 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 About[3].
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.dpk[4]. 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.
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.
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.
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.
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> e <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).
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!
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 :)
1 | http://docwiki.embarcadero.com/RADStudio/XE8/en/Extending_the_IDE_Using_the_Tools_API |
2 | HInstance, 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 |
3 | As 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 ;) |
4 | Este 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 |