Open Tools API - Um TForm modelo com propriedades especiais

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.

  Arquivos anexados  

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