Open Tools API - Um TDataModule com propriedades e métodos adicionais
Escrito por Carlos B. Feitoza Filho | |
Categoria: Artigos | |
Categoria Pai: Addicted 2 Delphi! | |
Acessos: 59238 |
Páginas dentro deste artigo
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 :)