Fórum Duvida Criação de Componente #412436

Duvida Criação de Componentes

Mensagempor coiotetg » Dom Fev 05, 2012 05:14
Olá a todos.
Eu ainda estou aprendendo sobre a criação de componentes então espero que tenham um pouco de paciência, mas vamos a duvida.
Eu estou adaptando um componente de conexão com o banco de dados os SqlDataSet, DataSetProvider e o ClientDataSet.
Como aqui na empresa trabalhamos com um sistema multi-banco ele faz a paginação automática dependendo do tipo de banco de dados e monta o select automático.
No SqlDataSet eu coloquei a propriedade HasChild que quando é setada para True ele cria o DataSetProvider e o ClientDataSet já configurado com as informações do SqlDataSet e todos conectados, até ai sem problemas.
O que estou tendo dificuldade é em fazer os novos componentes pegarem o Left e Top do SqlDataSet para serem criados ao lado dele.
Eu dei uma lida e vi que terei que utilizar o DefineProperties, mas não entendi como pegar o Left e o top e como definilos novamente, e como usar e criar um TFiler.
Fora isso não tenho problemas.


Código:

//FClientDatasetRpz.DefinePropertiesDst(TFiler); Não sei como chamar a procedure DefineProperties. Não dei como passar esse parametro Tfiler.


Fontes Completo
Código:


unit DBRpZ;

interface

uses
SysUtils, Classes, DB, SqlExpr, StrUtils, Controls, Forms, Graphics, Windows,
Messages, Dialogs, Variants, DBClient, Provider, CommCtrl;

type

TSQLDataSetRpz = class;
TDataSetProviderRpz = class;
TClientDataSetRpz = class;

////////////////////////////////////////////////////////////////////////////////
/// Consulta
////////////////////////////////////////////////////////////////////////////////
//type
TConsulta = class(TPersistent)
private
FTabelas,
FCampos,
FJoin,
FWhere,
FPrimaryKey,
FOrderBy : WideString;
FDivideDados : Boolean;
FQtdDados,
FPagina : Integer;
FCommandText : String;
Function MontaSelect( sender : TObject) : Boolean;
public
OldTabelas : WideString; //Crio estas variáveis para armazenar o antigo select
OldCampos : WideString;
OldRelacionamento : WideString;
OldWhere : WideString;
OldPrimaryKey : WideString;
OldOrderBy : WideString;
OldQtdDados : Integer;
OldPagina : Integer;
OldDivideDados : Boolean;
Function MontaSelectSqlServer : Boolean;
Function MontaSelectFirebird : Boolean;
Function MontaSelectOracle : Boolean;
procedure SalvaOld;
procedure CarregaOld;
procedure Assign(Source: TPersistent); override;
published
property Tabelas : WideString Read FTabelas Write FTabelas;
property Campos : WideString Read FCampos Write FCampos;
property Relacionamento : WideString Read FJoin Write FJoin;
property Where : WideString Read FWhere Write FWhere;
property PrimaryKey : WideString Read FPrimaryKey Write FPrimaryKey;
property OrderBy : WideString Read FOrderBy Write FOrderBY;
property QtdDados : Integer Read FQtdDados Write FQtdDados Default 50;
property Pagina : Integer Read FPagina Write FPagina Default 0;
Property DivideDados : Boolean Read FDivideDados write FDivideDados Default False;
end;


////////////////////////////////////////////////////////////////////////////////
/// Provider
////////////////////////////////////////////////////////////////////////////////
//type
TDataSetProviderRpz = class(TDataSetProvider)
private
protected
public
Constructor Create(Aowner:TComponent); Override;
Destructor Destroy; Override;
published
end;

////////////////////////////////////////////////////////////////////////////////
/// ClientDataSet
////////////////////////////////////////////////////////////////////////////////
//type
TClientDataSetRpz = Class(TClientDataSet)
private
FSQLDataSetRpz : TSQLDataSetRpz;
FConsulta : TConsulta;
FAtivaConsulta : Boolean;
procedure SetAtivo(const Value: Boolean);
procedure setSqlDataSetRpz(const Value: TSQLDataSetRpz);
protected
public
procedure DefinePropertiesDst(Filer: TFiler);
//procedure DefineProperties(Filer: TFiler); override;
procedure ReadLeft(Reader: TReader);
procedure WriteLeft (Writer: TWriter);
procedure ReadTop(Reader: TReader);
procedure WriteTop(Writer: TWriter);
Constructor Create(Aowner:TComponent); Override;
Destructor Destroy; Override;
published
property Consulta : TConsulta Read FConsulta Write FConsulta;
Property AtivaConsulta : Boolean Read FAtivaConsulta Write SetAtivo Default False;
property SQLDataSetRpz : TSQLDataSetRpz read FSQLDataSetRpz write setSqlDataSetRpz;
end;

////////////////////////////////////////////////////////////////////////////////
/// SqlDataSet
////////////////////////////////////////////////////////////////////////////////
//type
TSQLDataSetRpz = class(TSQLDataSet)
private
{ Private declarations }
FConsulta : TConsulta;
FProviderRpz : TDatasetProviderRpz;
FClientDatasetRpz : TClientDatasetRpz;
FAtivaConsulta : Boolean;
FChild : Boolean;
procedure SetAtivo(const Value: Boolean);
procedure SetChild(const Value: Boolean);
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(Aowner:TComponent); Override;
Destructor Destroy; Override;
published
{ Published declarations }
property Consulta : TConsulta Read FConsulta Write FConsulta;
Property AtivaConsulta : Boolean Read FAtivaConsulta Write SetAtivo Default False;
Property HasChild : Boolean Read FChild Write SetChild Default False;
end;


procedure Register;

implementation

procedure TConsulta.Assign(Source: TPersistent);
begin
if (Source is TConsulta) then
begin
Tabelas := TConsulta(Source).Tabelas;
Campos := TConsulta(Source).Campos;
Relacionamento := TConsulta(Source).Relacionamento;
Where := TConsulta(Source).Where;
PrimaryKey := TConsulta(Source).PrimaryKey;
OrderBy := TConsulta(Source).OrderBy;
QtdDados := TConsulta(Source).QtdDados;
Pagina := TConsulta(Source).Pagina;
DivideDados := TConsulta(Source).DivideDados;
end
else
inherited Assign(Source);
end;

procedure TConsulta.CarregaOld;
begin
FTabelas := OldTabelas;
FCampos := OldCampos;
FJoin := OldRelacionamento;
FWhere := OldWhere;
FPrimaryKey := OldPrimaryKey;
FOrderBy := OldOrderBy;
FQtdDados := OldQtdDados;
FPagina := OldPagina;
FDivideDados := OldDivideDados;
end;

function TConsulta.MontaSelect(sender: TObject): Boolean;
var
Conexao : TSQLConnection;
begin
Result := False;
try
if (sender is TSQLDataSetRpz) then
Conexao := TSQLDataSetRpz(sender).SQLConnection
else if (sender is TClientDataSetRpz) then
Conexao := TClientDataSetRpz(sender).SQLDataSetRpz.SQLConnection;

if Assigned(Conexao) then
Begin
if ((Conexao.ConnectionName <> EmptyStr) and (Conexao.DriverName <> EmptyStr)) then
Begin
if (Conexao.VendorLib <> EmptyStr) then
Begin
if pos(OCI, UpperCase(Conexao.VendorLib))> 0 then
Result := MontaSelectOracle
Else if (pos(GDS32, UpperCase(Conexao.VendorLib))> 0) or (pos(FBCLIENT, UpperCase(Conexao.VendorLib))> 0) then
Result := MontaSelectFirebird
Else if pos(SQLOLEDB, UpperCase(Conexao.VendorLib)) > 0 then
Result := MontaSelectSqlServer
Else
begin
Result := False;
raise Exception.Create(Sem suporte a este tipo de Banco de Dados);
end;
End
else
raise Exception.Create(Não foi encontrado o VendorLib.);
End
else
raise Exception.Create(O SqlConection não está configurado.);
End
Else
raise Exception.Create(Não foi indicada uma conexão com um banco de dados.);

if Result then
Begin
if (sender is TSQLDataSetRpz) then
TSQLDataSetRpz(sender).SetCommandText(FCommandText)
else if (sender is TClientDataSetRpz) then
TClientDataSetRpz(sender).SetCommandText(FCommandText);
End;

Except
on e:Exception do
begin
ShowMessage(e.Message);
Result := False;
end;
End;
end;

function TConsulta.MontaSelectFirebird: Boolean;
var
vlSelect,
vlWhere,
vlOrderBY : AnsiString;
begin
try
Result := False;
if ((FTabelas <> EmptyStr) and (FCampos <> EmptyStr)) then
Begin
vlSelect := Select ;

if FDivideDados then
vlSelect := vlSelect +First +IntToStr(FQtdDados)+ skip + IntToStr(FPagina * FQtdDados)+ ;

vlSelect := vlSelect + FCampos + From + FTabelas+ ;
vlWhere := Where ;

if (FJoin <> EmptyStr) then
vlWhere := vlWhere + Relacionamento+ ;

if (FWhere <> EmptyStr) then
Begin
if Length(vlWhere) > 7 then
vlWhere := vlWhere + and + FWhere
else
vlWhere := vlWhere + FWhere;
End;

if (FOrderBy <> EmptyStr) then
vlOrderBY := Order By + FOrderBy;

FCommandText := vlSelect;

if Length(vlWhere) > 7 then
FCommandText := FCommandText + vlWhere;

FCommandText := FCommandText+ vlOrderBy;
Result := True;
End
else
raise Exception.Create(Informe os campos e Tabelas a serem consultados.);
Except
on e: Exception do
begin
ShowMessage(e.Message);
Result := False;
end;
End;
end;

function TConsulta.MontaSelectOracle: Boolean;
var
vlSelect,
vlWhere,
vlOrderBY : AnsiString;
begin
try
Result := False;
if ((FTabelas <> EmptyStr) and (FCampos <> ) and (FCampos <> EmptyStr)) then
Begin
vlSelect := Select ;
vlSelect := vlSelect + FCampos + From + FTabelas+ ;
vlWhere := Where ;

if FDivideDados then
vlWhere := vlWhere +RowNum between +IntToStr(FPagina)+ And + IntToStr(FQtdDados)+ ;

if (FJoin <> EmptyStr) then
Begin
if Length(vlWhere) > 7 then
vlWhere := vlWhere + and +FJoin+
else
vlWhere := vlWhere + FJoin+ ;
End;

if (FWhere <> EmptyStr) then
Begin
if Length(vlWhere) > 7 then
vlWhere := vlWhere + and +Fwhere+
else
vlWhere := vlWhere + Fwhere + ;
End;

if (FOrderBy <> EmptyStr) then
vlOrderBY := Order By + FOrderBy;

FCommandText := vlSelect;

if Length(vlWhere) > 7 then
FCommandText := FCommandText + vlWhere;

FCommandText := FCommandText+ vlOrderBy;
Result := True;
End
else
raise Exception.Create(Informe os campos e Tabelas a serem consultados.);
Except
on e: Exception do
begin
ShowMessage(e.Message);
Result := False;
end;
End;
end;

function TConsulta.MontaSelectSqlServer: Boolean;
var
vlSelect,
vlWhere,
vlSubSelect,
vlSubWhere,
vlOrderBY : AnsiString;
begin
try
Result := False;
vlSelect := EmptyStr;
vlWhere := EmptyStr;
vlSubSelect := EmptyStr;
vlSubWhere := EmptyStr;

if (FTabelas <> EmptyStr) and (FCampos <> EmptyStr) then
Begin
vlSelect := Select ;

if FDivideDados then
begin
if (FPrimaryKey <> EmptyStr) then
vlSelect := vlSelect + Top (+ IntToStr(FQtdDados)+)
else
raise Exception.Create(A propriedade PrimaryKey não pode estar vazia);
end;

vlSelect := vlSelect + FCampos + From + FTabelas + ;

if (FJoin <> EmptyStr) then
vlWhere := Where + FJoin+ ;

if FDivideDados then
Begin
vlSubSelect := (+FPrimaryKey+ not in ( select top(+ IntToStr(FPagina*FQtdDados)+) + FPrimaryKey + from + FTabelas+ ;

if (vlWhere <> EmptyStr) then
vlSubWhere := vlWhere ;

if ((FWhere <> ) and (FWhere <> EmptyStr)) then
Begin
if vlWhere <> EmptyStr then
vlSubWhere := vlWhere + and + FWhere
Else
vlSubWhere := FWhere;
End;

vlSubWhere := )) ;

if (vlWhere <> EmptyStr) then
vlWhere := vlWhere + and + vlSubSelect+ vlSubWhere
else
vlWhere := FWhere + vlSubSelect+ vlSubWhere;
End;

if (FWhere <> EmptyStr) then
Begin
if (vlWhere <> EmptyStr) then
vlWhere := vlWhere + and + FWhere +
Else
vlWhere := FWhere;
End;

if (FOrderBy <> EmptyStr) then
vlOrderBY := Order By + FOrderBy;

FCommandText := vlSelect;

if (vlWhere <> EmptyStr) then
FCommandText := FCommandText + vlWhere;

FCommandText := FCommandText+ vlOrderBy;
Result := True;
End
else
raise Exception.Create(Informe os campos e Tabelas a serem consultados.);
Except
on e: Exception do
begin
ShowMessage(e.Message);
Result := False;
end;
End;
end;

procedure TConsulta.SalvaOld;
begin
OldTabelas := FTabelas;
OldCampos := FCampos;
OldRelacionamento := FJoin;
OldWhere := FWhere;
OldPrimaryKey := FPrimaryKey;
OldOrderBy := FOrderBy;
OldQtdDados := FQtdDados;
OldPagina := FPagina;
OldDivideDados := FDivideDados;
end;

constructor TSQLDataSetRpz.Create(Aowner: TComponent);
begin
inherited Create(AOwner);
FConsulta := TConsulta.Create;
FChild := False;
FConsulta.QtdDados := 50;
FConsulta.OrderBy := 1;
end;

destructor TSQLDataSetRpz.Destroy;
begin
if Assigned(FClientDatasetRpz) then
TClientDataSetRpz(FClientDatasetRpz).setSqlDataSetRpz(nil);
FreeAndNil(FConsulta);
inherited Destroy;
end;

procedure TSQLDataSetRpz.SetAtivo(const Value: Boolean);
begin
try
FAtivaConsulta := Value;
if FAtivaConsulta then
Consulta.MontaSelect(Self);
finally
FAtivaConsulta := False;
end;
end;

procedure TSQLDataSetRpz.SetChild(const Value: Boolean);
begin
try
FChild := Value;
if FChild then
begin
if not Assigned(FProviderRpz) then
begin
FProviderRpz := TDataSetProviderRpz.Create(OWNER); // Crio o Provider e vinculo com o SqlDataSet
with FProviderRpz do
Begin
DataSet := Self;
Name := dsp+Copy(Self.Name, 4, length(self.Name)); // Aqui não sei definir Left e top
End;
end;
if ((not Assigned(Self.FClientDatasetRpz)) or (Self.FClientDatasetRpz = nil)) then
begin
Self.FClientDatasetRpz := TClientDataSetRpz.Create(OWNER); //Crio o Cds configuro e vinculo com o Provider.
with Self.FClientDatasetRpz do
Begin
Name := cds+Copy(Self.Name, 4, length(self.Name));
setSqlDataSetRpz(Self);
//FClientDatasetRpz.DefinePropertiesDst(TFiler); Aqui não sei como chamar a procedure DefineProperties. Não dei como passar esse parametro Tfiler.
End;
end;
end;
finally
FChild := False;
end;
end;

{ TClientDataSetRpz }

constructor TClientDataSetRpz.Create(Aowner: TComponent);
begin
inherited Create(Aowner);
FConsulta := TConsulta.Create;
FConsulta.QtdDados := 50;
FConsulta.OrderBy := 1;
end;

{procedure TClientDataSetRpz.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
if Assigned(FSQLDataSetRpz) then
DefinePropertiesDst(Filer);
end; }

procedure TClientDataSetRpz.DefinePropertiesDst(Filer: TFiler);
var
Ancestor: TComponent;
Info: Longint;
begin
Info := 0;
Ancestor := TComponent(FSQLDataSetRpz);
if Ancestor<>nil then
Info:=Ancestor.DesignInfo;
Filer.DefineProperty(Left,ReadLeft,WriteLeft, LongRec(FSQLDataSetRpz.DesignInfo).Lo <> LongRec(Info).Lo);
Filer.DefineProperty(Top,ReadTop,WriteTop, LongRec(FSQLDataSetRpz.DesignInfo).Hi <> LongRec(Info).Hi);
end;

procedure TClientDataSetRpz.ReadTop(Reader: TReader);
var
DI: LongRec;
begin
DI:=LongRec(FSQLDataSetRpz.DesignInfo);
DI.Hi:=Reader.ReadInteger;
DesignInfo:=Longint(DI);
end;

procedure TClientDataSetRpz.WriteTop(Writer: TWriter);
begin
Writer.WriteInteger(LongRec(DesignInfo).Hi);
end;

procedure TClientDataSetRpz.ReadLeft(Reader: TReader);
var
DI: LongRec;
begin
DI:=LongRec(FSQLDataSetRpz.DesignInfo);
DI.Lo:=Reader.ReadInteger+10;
DesignInfo:=Longint(DI);
end;

procedure TClientDataSetRpz.WriteLeft(Writer: TWriter);
begin
Writer.WriteInteger(LongRec(DesignInfo).Lo);
end;

destructor TClientDataSetRpz.Destroy;
var
vlDataset : TSQLDataSetRpz;
begin
FreeAndNil(FConsulta);
vlDataset := FSQLDataSetRpz;
Self.setSqlDataSetRpz(nil);
inherited Destroy;
if vlDataset <> nil then
begin
if Assigned(vlDataset.FClientDatasetRpz) then
begin
vlDataset.FClientDatasetRpz := nil;
end;
end;
end;

procedure TClientDataSetRpz.SetAtivo(const Value: Boolean);
begin
try
FAtivaConsulta := Value;
if FAtivaConsulta then
FConsulta.MontaSelect(Self); //Mando Criar a consulta
finally
FAtivaConsulta := False;
end;
end;

procedure TClientDataSetRpz.setSqlDataSetRpz(const Value: TSQLDataSetRpz);
begin
FSQLDataSetRpz := Value;
if Assigned(FSQLDataSetRpz) then
begin
if Self.Consulta <> FSQLDataSetRpz.Consulta then
begin
with Self, Consulta do
Begin
Tabelas := FSQLDataSetRpz.Consulta.Tabelas;
Campos := FSQLDataSetRpz.Consulta.Campos;
Relacionamento := FSQLDataSetRpz.Consulta.Relacionamento;
Where := FSQLDataSetRpz.Consulta.Where;
OrderBy := FSQLDataSetRpz.Consulta.OrderBy;
DivideDados := FSQLDataSetRpz.Consulta.DivideDados;
QtdDados := FSQLDataSetRpz.Consulta.QtdDados;
Pagina := FSQLDataSetRpz.Consulta.Pagina;
PrimaryKey := FSQLDataSetRpz.Consulta.PrimaryKey;
if ProviderName = EmptyStr then
ProviderName := FSQLDataSetRpz.FProviderRpz.Name;
CommandText := FSQLDataSetRpz.CommandText;
FetchParams;
end;
if FSQLDataSetRpz.FClientDatasetRpz <> Self then
FSQLDataSetRpz.FClientDatasetRpz := Self;
end;
end;
end;

{ TDataSetProviderRpz }

constructor TDataSetProviderRpz.Create(Aowner: TComponent);
begin
inherited Create(Aowner); //Inicio o Provider já Pré definido
UpdateMode := upWhereChanged;
Options := [poFetchDetailsOnDemand,poIncFieldProps,poAutoRefresh,poPropogateChanges,poAllowCommandText,poUseQuoteChar];
end;

destructor TDataSetProviderRpz.Destroy;
var
vlData : TSQLDataSetRpz;
begin
if Assigned(Self.DataSet) then
begin
if (Self.DataSet is TSQLDataSetRpz) then
vlData := TSQLDataSetRpz(Self.DataSet);
end
else
vlData := nil;
inherited Destroy;
if vlData <> nil then
begin
if Assigned(vlData.FProviderRpz) then
vlData.FProviderRpz := Nil;
end;
end;

procedure Register;
begin
RegisterComponents(RpZ, [TSQLDataSetRpz]);
RegisterComponents(RpZ, [TDataSetProviderRpz]);
RegisterComponents(RpZ, [TClientDataSetRpz]);
end;

end.


Fiquem a vontade em dar sugestões para melhorar o desempenho do componente como eu disse sou iniciante em criação de componentes.
Obrigado pela colaboração.