Fórum Duvida com criação de componente #412161

31/01/2012

0

Delphi


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.
E também quando fecho o projeto ele da um erro “Invalid Pointer Operation”.
Segue o Fonte:
unit DBRpZ;

interface

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

////////////////////////////////////////////////////////////////////////////////
///  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;

////////////////////////////////////////////////////////////////////////////////
///  SqlDataSet
////////////////////////////////////////////////////////////////////////////////

type
  TSQLDataSetRpz = class(TSQLDataSet)
  private
    FConsulta         : TConsulta;
    FAtivaConsulta    : Boolean;
    FChild            : Boolean;
    procedure SetAtivo(const Value: Boolean);
    procedure SetChild(const Value: Boolean);
    { Private declarations }
  protected
    { Protected declarations }
  public
    Constructor Create(Aowner:TComponent); Override;
    Destructor Destroy; Override;
    { Public declarations }
  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 True;

  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
    FConsulta       : TConsulta;
    FSQLConnection  : TSQLConnection;
    FAtivaConsulta  : Boolean;
    procedure SetAtivo(const Value: Boolean);
    procedure SetSQLConnection(const Value: TSQLConnection);
  Protected

  public
    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 SQLConnection       : TSQLConnection  read FSQLConnection     write SetSQLConnection;

end;

procedure Register;

implementation

procedure TConsulta.Assign(Source: TPersistent);
begin
  inherited;
  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;
    Exit;
  end;
  inherited Assign(Source);
end;

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

destructor TSQLDataSetRpz.Destroy;
begin
  FreeAndNil(FConsulta);
  inherited Destroy;
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
  Begin
    Conexao :=  TSQLDataSetRpz(sender).SQLConnection;
  End
 else if sender is TClientDataSetRpz then
  Begin
     Conexao := TClientDataSetRpz(sender).SQLConnection;
  End;
 if Assigned(Conexao) then
  Begin
    if ((Conexao.ConnectionName <> EmptyStr) and (Conexao.ConnectionName <> ) and (Conexao.DriverName <> ) and (Conexao.DriverName <> EmptyStr)) then
     Begin
      if ((Conexao.VendorLib <> ) and (Conexao.VendorLib <> EmptyStr)) then
       Begin
        if pos(OCI, UpperCase(Conexao.VendorLib))> 0  then
         Begin
          Result := MontaSelectOracle
         End
        Else if pos(GDS32, UpperCase(Conexao.VendorLib))> 0 then
         Begin
          Result := MontaSelectFirebird;
         End
        Else if pos(SQLOLEDB, UpperCase(Conexao.VendorLib)) > 0 then
         Begin
          Result := MontaSelectSqlServer;
         End
        Else
         Result := False;
       End;
     End;
  End
 Else
  begin
   ShowMessage(Não existe conexão com o banco configurado.);
   Exit;
  end;

 if Result then
  Begin
   if sender is TSQLDataSetRpz then
    Begin
     TSQLDataSetRpz(sender).SetCommandText(FCommandText);
    End
   else if sender is TClientDataSetRpz then
    begin
     TClientDataSetRpz(sender).SetCommandText(FCommandText);
    End;
  End
 Else
  ShowMessage(Erro ao gerar a consulta.);
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 ((Tabelas <> ) and (Tabelas <> EmptyStr) and (Campos <> ) and (Campos <> EmptyStr)) then
    Begin
     vlSelect := Select ;
     if DivideDados then
       vlSelect := vlSelect +First +IntToStr(QtdDados)+  skip + IntToStr(Pagina * QtdDados)+ ;
     vlSelect := vlSelect + Campos + From + Tabelas + ;
     vlWhere := Where ;
     if ((Relacionamento <> ) and (Relacionamento <> EmptyStr)) then
       vlWhere := vlWhere + Relacionamento+ ;
     if ((Where <> ) and (Where <> EmptyStr)) then
      Begin
       if Length(vlWhere) > 7 then
        vlWhere := vlWhere +  and  + Where
       else
        vlWhere := vlWhere + Where;
      End;
     if ((OrderBy <> ) and (OrderBy <> EmptyStr)) then
       vlOrderBY :=  Order By + OrderBy;
     FCommandText := vlSelect;
     if Length(vlWhere) > 7 then
       FCommandText := FCommandText + vlWhere;
     FCommandText := FCommandText+ vlOrderBy;
     Result := True;
    End
   else
    begin
     ShowMessage(Informe os campos e Tabelas a serem consultados.);
     Exit;
    end;
Except
 Result := False;
End;
end;

function TConsulta.MontaSelectOracle: Boolean;
var
 vlSelect,
 vlWhere,
 vlOrderBY  : AnsiString;
begin
Try
Result := False;
   if ((Tabelas <> ) and (Tabelas <> EmptyStr) and (Campos <> ) and (Campos <> EmptyStr)) then
    Begin
     vlSelect := Select ;
     vlSelect := vlSelect + Campos + From + Tabelas + ;
     vlWhere := Where ;
     if DivideDados then
       vlWhere := vlWhere +RowNum between +IntToStr(Pagina)+  And + IntToStr(QtdDados)+ ;
     if ((Relacionamento <> ) and (Relacionamento <> EmptyStr)) then
      Begin
       if Length(vlWhere) > 7 then
        vlWhere := vlWhere +  and  +Relacionamento+ 
       else
        vlWhere := vlWhere + Relacionamento +  ;
      End;
     if ((Where <> ) and (Where <> EmptyStr)) then
      Begin
       if Length(vlWhere) > 7 then
        vlWhere := vlWhere +  and  +where+ 
       else
        vlWhere := vlWhere + where +  ;
      End;
     if ((OrderBy <> ) and (OrderBy <> EmptyStr)) then
       vlOrderBY :=  Order By + OrderBy;
     FCommandText := vlSelect;
     if Length(vlWhere) > 7 then
       FCommandText := FCommandText + vlWhere;
     FCommandText := FCommandText+ vlOrderBy;
     Result := True;
    End
   else
    begin
     ShowMessage(Informe os campos e Tabelas a serem consultados.);
     Exit;
    end;
Except
 Result := False;
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 ((Tabelas <> ) and (Tabelas <> EmptyStr) and (Campos <> ) and (Campos <> EmptyStr)) then
    Begin
     vlSelect := Select ;
     if DivideDados then
      begin
       if ((PrimaryKey <> ) and (PrimaryKey <> EmptyStr)) then
        vlSelect := vlSelect + Top (+ IntToStr(QtdDados)+) 
       else
        begin
         ShowMessage(O campo PrimaryKey não pode estar vazio);
         Exit;
        end;
      end;
     vlSelect := vlSelect + Campos +  From + Tabelas + ;
     if ((Relacionamento <> ) and (Relacionamento <> EmptyStr))  then
      vlWhere :=  Where + Relacionamento+  ;
     if DivideDados then
      Begin
       vlSubSelect := (+PrimaryKey+ not in ( select top(+ IntToStr(Pagina*QtdDados)+) + PrimaryKey +  from + Tabelas+ ;
       if vlWhere <> EmptyStr then
         vlSubWhere := vlWhere ;
       if ((Where <> ) and (Where <> EmptyStr)) then
        Begin
         if vlWhere <> EmptyStr then
          vlSubWhere := vlWhere +  and + Where
         Else
          vlSubWhere :=  Where + Where;
         //vlSubwhere := vlSubWhere +  and + Where +)) ;
        End;
        vlSubWhere   := )) ;
        if vlWhere <> EmptyStr then
          vlWhere := vlWhere +  and + vlSubSelect+ vlSubWhere
        else
          vlWhere :=  Where + vlSubSelect+ vlSubWhere;
      End;
     if ((Where <> ) and (Where <> EmptyStr)) then
      Begin
       if vlWhere <> EmptyStr then
        vlWhere := vlWhere +  and + Where +  
       Else
        vlWhere :=  Where + Where;
      End;
     if ((OrderBy <> ) and (OrderBy <> EmptyStr)) then
       vlOrderBY :=  Order By + OrderBy;
     FCommandText := vlSelect;
     if vlWhere <> EmptyStr then
       FCommandText := FCommandText + vlWhere;
     FCommandText := FCommandText+ vlOrderBy;
     Result := True;
    End
   else
    begin
     ShowMessage(Informe os campos e Tabelas a serem consultados.);
     Exit;
    end;
 Except
  Result := False;
 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;

procedure TSQLDataSetRpz.SetAtivo(const Value: Boolean);
begin
  FAtivaConsulta := Value;
  if FAtivaConsulta then
   Begin
    Consulta.MontaSelect(Self)
   End;
      FAtivaConsulta := False;
  //TWinControl(GetOwner).Invalidate;
end;

procedure TSQLDataSetRpz.SetChild(const Value: Boolean);var
 vlCds : TClientDataSetRpz;
 vlDsp : TDataSetProviderRpz;
begin
  FChild                    := Value;
  if Value then
   begin
    vlDsp                   := TDataSetProviderRpz.Create(OWNER); // Crio o Provider e vinculo com o SqlDataSet
    with vlDsp do
     Begin
      DataSet               := Self;
      Name                  := dsp+Copy(Self.Name, 4, length(self.Name)); // Aqui não sei definir Left e top
     End;
    vlCds                   := TClientDataSetRpz.Create(OWNER);  //Crio o Cds configuro e vinculo com o Provider.
    with vlCds do
     Begin
      Consulta                     := self.Consulta;
      ProviderName          := vlDsp.Name;
      SQLConnection         := Self.SQLConnection;
      Name                         := cds+Copy(Self.Name, 4, length(self.Name));
      CommandText           := Self.CommandText; // Aqui não sei definir Left e top

     End;
   end;
end;

procedure TClientDataSetRpz.SetAtivo(const Value: Boolean);
begin
  FAtivaConsulta := Value;
  if FAtivaConsulta then
   Begin
     Consulta.MontaSelect(Self) //Mando Criar a consulta
   End;
      FAtivaConsulta := False;
  //TWinControl(GetOwner).Invalidate;
end;

procedure TClientDataSetRpz.SetSQLConnection(const Value: TSQLConnection);
begin
  FSQLConnection := Value;
end;

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

{ TClientDataSetFre }

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

destructor TClientDataSetRpz.Destroy;
begin
  FreeAndNil(FConsulta);
  inherited Destroy;
end;

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

end;

destructor TDataSetProviderRpz.Destroy;
begin
  inherited Destroy;
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.
Tiago Soares

Tiago Soares

Responder

Posts

31/01/2012

Tiago Soares

Bugo o codigo em cima segue novamente
unit DBRpZ;

interface

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

////////////////////////////////////////////////////////////////////////////////
///  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;

////////////////////////////////////////////////////////////////////////////////
///  SqlDataSet
////////////////////////////////////////////////////////////////////////////////

type
  TSQLDataSetRpz = class(TSQLDataSet)
  private
    FConsulta         : TConsulta;
    FAtivaConsulta    : Boolean;
    FChild            : Boolean;
    procedure SetAtivo(const Value: Boolean);
    procedure SetChild(const Value: Boolean);
    { Private declarations }
  protected
    { Protected declarations }
  public
    Constructor Create(Aowner:TComponent); Override;
    Destructor Destroy; Override;
    { Public declarations }
  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 True;

  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
    FConsulta       : TConsulta;
    FSQLConnection  : TSQLConnection;
    FAtivaConsulta  : Boolean;
    procedure SetAtivo(const Value: Boolean);
    procedure SetSQLConnection(const Value: TSQLConnection);
  Protected

  public
    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 SQLConnection       : TSQLConnection  read FSQLConnection     write SetSQLConnection;

end;

procedure Register;

implementation

procedure TConsulta.Assign(Source: TPersistent);
begin
  inherited;
  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;
    Exit;
  end;
  inherited Assign(Source);
end;

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

destructor TSQLDataSetRpz.Destroy;
begin
  FreeAndNil(FConsulta);
  inherited Destroy;
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
  Begin
    Conexao :=  TSQLDataSetRpz(sender).SQLConnection;
  End
 else if sender is TClientDataSetRpz then
  Begin
     Conexao := TClientDataSetRpz(sender).SQLConnection;
  End;
 if Assigned(Conexao) then
  Begin
    if ((Conexao.ConnectionName <> EmptyStr) and (Conexao.ConnectionName <> ) and (Conexao.DriverName <> ) and (Conexao.DriverName <> EmptyStr)) then
     Begin
      if ((Conexao.VendorLib <> ) and (Conexao.VendorLib <> EmptyStr)) then
       Begin
        if pos(OCI, UpperCase(Conexao.VendorLib))> 0  then
         Begin
          Result := MontaSelectOracle
         End
        Else if pos(GDS32, UpperCase(Conexao.VendorLib))> 0 then
         Begin
          Result := MontaSelectFirebird;
         End
        Else if pos(SQLOLEDB, UpperCase(Conexao.VendorLib)) > 0 then
         Begin
          Result := MontaSelectSqlServer;
         End
        Else
         Result := False;
       End;
     End;
  End
 Else
  begin
   ShowMessage(Não existe conexão com o banco configurado.);
   Exit;
  end;

 if Result then
  Begin
   if sender is TSQLDataSetRpz then
    Begin
     TSQLDataSetRpz(sender).SetCommandText(FCommandText);
    End
   else if sender is TClientDataSetRpz then
    begin
     TClientDataSetRpz(sender).SetCommandText(FCommandText);
    End;
  End
 Else
  ShowMessage(Erro ao gerar a consulta.);
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 ((Tabelas <> ) and (Tabelas <> EmptyStr) and (Campos <> ) and (Campos <> EmptyStr)) then
    Begin
     vlSelect := Select ;
     if DivideDados then
       vlSelect := vlSelect +First +IntToStr(QtdDados)+  skip + IntToStr(Pagina * QtdDados)+ ;
     vlSelect := vlSelect + Campos + From + Tabelas + ;
     vlWhere := Where ;
     if ((Relacionamento <> ) and (Relacionamento <> EmptyStr)) then
       vlWhere := vlWhere + Relacionamento+ ;
     if ((Where <> ) and (Where <> EmptyStr)) then
      Begin
       if Length(vlWhere) > 7 then
        vlWhere := vlWhere +  and  + Where
       else
        vlWhere := vlWhere + Where;
      End;
     if ((OrderBy <> ) and (OrderBy <> EmptyStr)) then
       vlOrderBY :=  Order By + OrderBy;
     FCommandText := vlSelect;
     if Length(vlWhere) > 7 then
       FCommandText := FCommandText + vlWhere;
     FCommandText := FCommandText+ vlOrderBy;
     Result := True;
    End
   else
    begin
     ShowMessage(Informe os campos e Tabelas a serem consultados.);
     Exit;
    end;
Except
 Result := False;
End;
end;

function TConsulta.MontaSelectOracle: Boolean;
var
 vlSelect,
 vlWhere,
 vlOrderBY  : AnsiString;
begin
Try
Result := False;
   if ((Tabelas <> ) and (Tabelas <> EmptyStr) and (Campos <> ) and (Campos <> EmptyStr)) then
    Begin
     vlSelect := Select ;
     vlSelect := vlSelect + Campos + From + Tabelas + ;
     vlWhere := Where ;
     if DivideDados then
       vlWhere := vlWhere +RowNum between +IntToStr(Pagina)+  And + IntToStr(QtdDados)+ ;
     if ((Relacionamento <> ) and (Relacionamento <> EmptyStr)) then
      Begin
       if Length(vlWhere) > 7 then
        vlWhere := vlWhere +  and  +Relacionamento+ 
       else
        vlWhere := vlWhere + Relacionamento +  ;
      End;
     if ((Where <> ) and (Where <> EmptyStr)) then
      Begin
       if Length(vlWhere) > 7 then
        vlWhere := vlWhere +  and  +where+ 
       else
        vlWhere := vlWhere + where +  ;
      End;
     if ((OrderBy <> ) and (OrderBy <> EmptyStr)) then
       vlOrderBY :=  Order By + OrderBy;
     FCommandText := vlSelect;
     if Length(vlWhere) > 7 then
       FCommandText := FCommandText + vlWhere;
     FCommandText := FCommandText+ vlOrderBy;
     Result := True;
    End
   else
    begin
     ShowMessage(Informe os campos e Tabelas a serem consultados.);
     Exit;
    end;
Except
 Result := False;
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 ((Tabelas <> ) and (Tabelas <> EmptyStr) and (Campos <> ) and (Campos <> EmptyStr)) then
    Begin
     vlSelect := Select ;
     if DivideDados then
      begin
       if ((PrimaryKey <> ) and (PrimaryKey <> EmptyStr)) then
        vlSelect := vlSelect + Top (+ IntToStr(QtdDados)+) 
       else
        begin
         ShowMessage(O campo PrimaryKey não pode estar vazio);
         Exit;
        end;
      end;
     vlSelect := vlSelect + Campos +  From + Tabelas + ;
     if ((Relacionamento <> ) and (Relacionamento <> EmptyStr))  then
      vlWhere :=  Where + Relacionamento+  ;
     if DivideDados then
      Begin
       vlSubSelect := (+PrimaryKey+ not in ( select top(+ IntToStr(Pagina*QtdDados)+) + PrimaryKey +  from + Tabelas+ ;
       if vlWhere <> EmptyStr then
         vlSubWhere := vlWhere ;
       if ((Where <> ) and (Where <> EmptyStr)) then
        Begin
         if vlWhere <> EmptyStr then
          vlSubWhere := vlWhere +  and + Where
         Else
          vlSubWhere :=  Where + Where;
         //vlSubwhere := vlSubWhere +  and + Where +)) ;
        End;
        vlSubWhere   := )) ;
        if vlWhere <> EmptyStr then
          vlWhere := vlWhere +  and + vlSubSelect+ vlSubWhere
        else
          vlWhere :=  Where + vlSubSelect+ vlSubWhere;
      End;
     if ((Where <> ) and (Where <> EmptyStr)) then
      Begin
       if vlWhere <> EmptyStr then
        vlWhere := vlWhere +  and + Where +  
       Else
        vlWhere :=  Where + Where;
      End;
     if ((OrderBy <> ) and (OrderBy <> EmptyStr)) then
       vlOrderBY :=  Order By + OrderBy;
     FCommandText := vlSelect;
     if vlWhere <> EmptyStr then
       FCommandText := FCommandText + vlWhere;
     FCommandText := FCommandText+ vlOrderBy;
     Result := True;
    End
   else
    begin
     ShowMessage(Informe os campos e Tabelas a serem consultados.);
     Exit;
    end;
 Except
  Result := False;
 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;

procedure TSQLDataSetRpz.SetAtivo(const Value: Boolean);
begin
  FAtivaConsulta := Value;
  if FAtivaConsulta then
   Begin
    Consulta.MontaSelect(Self)
   End;
      FAtivaConsulta := False;
  //TWinControl(GetOwner).Invalidate;
end;

procedure TSQLDataSetRpz.SetChild(const Value: Boolean);var
 vlCds : TClientDataSetRpz;
 vlDsp : TDataSetProviderRpz;
begin
  FChild                    := Value;
  if Value then
   begin
    vlDsp                   := TDataSetProviderRpz.Create(OWNER); // Crio o Provider e vinculo com o SqlDataSet
    with vlDsp do
     Begin
      DataSet               := Self;
      Name                  := dsp+Copy(Self.Name, 4, length(self.Name)); // Aqui não sei definir Left e top
     End;
    vlCds                   := TClientDataSetRpz.Create(OWNER);  //Crio o Cds configuro e vinculo com o Provider.
    with vlCds do
     Begin
      Consulta                     := self.Consulta;
      ProviderName          := vlDsp.Name;
      SQLConnection         := Self.SQLConnection;
      Name                         := cds+Copy(Self.Name, 4, length(self.Name));
      CommandText           := Self.CommandText; // Aqui não sei definir Left e top

     End;
   end;
end;

procedure TClientDataSetRpz.SetAtivo(const Value: Boolean);
begin
  FAtivaConsulta := Value;
  if FAtivaConsulta then
   Begin
     Consulta.MontaSelect(Self) //Mando Criar a consulta
   End;
      FAtivaConsulta := False;
  //TWinControl(GetOwner).Invalidate;
end;

procedure TClientDataSetRpz.SetSQLConnection(const Value: TSQLConnection);
begin
  FSQLConnection := Value;
end;

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

{ TClientDataSetFre }

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

destructor TClientDataSetRpz.Destroy;
begin
  FreeAndNil(FConsulta);
  inherited Destroy;
end;

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

end;

destructor TDataSetProviderRpz.Destroy;
begin
  inherited Destroy;
end;

end.
Responder

Gostei + 0

31/01/2012

Tiago Soares 

unit DBRpZ;

interface

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

////////////////////////////////////////////////////////////////////////////////
///  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;
    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;

////////////////////////////////////////////////////////////////////////////////
///  SqlDataSet
////////////////////////////////////////////////////////////////////////////////

type
  TSQLDataSetRpz = class(TSQLDataSet)
  private
    FConsulta         : TConsulta;
    FAtivaConsulta    : Boolean;
    FChild            : Boolean;
    procedure SetAtivo(const Value: Boolean);
    procedure SetChild(const Value: Boolean);
    { Private declarations }
  protected
    { Protected declarations }
  public
    Constructor Create(Aowner:TComponent); Override;
    Destructor Destroy; Override;
    { Public declarations }
  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 True;

  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
    FConsulta       : TConsulta;
    FSQLConnection  : TSQLConnection;
    FAtivaConsulta  : Boolean;
    procedure SetAtivo(const Value: Boolean);
    procedure SetSQLConnection(const Value: TSQLConnection);
  Protected

  public
    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 SQLConnection       : TSQLConnection  read FSQLConnection     write SetSQLConnection;

end;

procedure Register;

implementation

procedure TConsulta.Assign(Source: TPersistent);
begin
  inherited;
  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;
    Exit;
  end;
  inherited Assign(Source);
end;

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

destructor TSQLDataSetRpz.Destroy;
begin
  FreeAndNil(FConsulta);
  inherited Destroy;
end;

procedure TConsulta.CarregaOld;
begin
 FTabelas           := OldTabelas;     // Volto o select antigo.
 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
  Begin
    Conexao :=  TSQLDataSetRpz(sender).SQLConnection;
  End
 else if sender is TClientDataSetRpz then
  Begin
     Conexao := TClientDataSetRpz(sender).SQLConnection;
  End;
 if Assigned(Conexao) then
  Begin
    if ((Conexao.ConnectionName <> EmptyStr) and (Conexao.ConnectionName <> ) and (Conexao.DriverName <> ) and (Conexao.DriverName <> EmptyStr)) then
     Begin
      if ((Conexao.VendorLib <> ) and (Conexao.VendorLib <> EmptyStr)) then
       Begin
        if pos(OCI, UpperCase(Conexao.VendorLib))> 0  then
         Begin
          Result := MontaSelectOracle
         End
        Else if pos(GDS32, UpperCase(Conexao.VendorLib))> 0 then
         Begin
          Result := MontaSelectFirebird;
         End
        Else if pos(SQLOLEDB, UpperCase(Conexao.VendorLib)) > 0 then
         Begin
          Result := MontaSelectSqlServer;
         End
        Else
         Result := False;
       End;
     End;
  End
 Else
  begin
   ShowMessage(Não existe conexão com o banco configurado.);
   Exit;
  end;

 if Result then
  Begin
   if sender is TSQLDataSetRpz then
    Begin
     TSQLDataSetRpz(sender).SetCommandText(FCommandText);
    End
   else if sender is TClientDataSetRpz then
    begin
     TClientDataSetRpz(sender).SetCommandText(FCommandText);
    End;
  End
 Else
  ShowMessage(Erro ao gerar a consulta.);
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 ((Tabelas <> ) and (Tabelas <> EmptyStr) and (Campos <> ) and (Campos <> EmptyStr)) then
    Begin
     vlSelect := Select ;
     if DivideDados then
       vlSelect := vlSelect +First +IntToStr(QtdDados)+  skip + IntToStr(Pagina * QtdDados)+ ;
     vlSelect := vlSelect + Campos + From + Tabelas + ;
     vlWhere := Where ;
     if ((Relacionamento <> ) and (Relacionamento <> EmptyStr)) then
       vlWhere := vlWhere + Relacionamento+ ;
     if ((Where <> ) and (Where <> EmptyStr)) then
      Begin
       if Length(vlWhere) > 7 then
        vlWhere := vlWhere +  and  + Where
       else
        vlWhere := vlWhere + Where;
      End;
     if ((OrderBy <> ) and (OrderBy <> EmptyStr)) then
       vlOrderBY :=  Order By + OrderBy;
     FCommandText := vlSelect;
     if Length(vlWhere) > 7 then
       FCommandText := FCommandText + vlWhere;
     FCommandText := FCommandText+ vlOrderBy;
     Result := True;
    End
   else
    begin
     ShowMessage(Informe os campos e Tabelas a serem consultados.);
     Exit;
    end;
Except
 Result := False;
End;
end;

function TConsulta.MontaSelectOracle: Boolean;
var
 vlSelect,
 vlWhere,
 vlOrderBY  : AnsiString;
begin
Try
Result := False;
   if ((Tabelas <> ) and (Tabelas <> EmptyStr) and (Campos <> ) and (Campos <> EmptyStr)) then
    Begin
     vlSelect := Select ;
     vlSelect := vlSelect + Campos + From + Tabelas + ;
     vlWhere := Where ;
     if DivideDados then
       vlWhere := vlWhere +RowNum between +IntToStr(Pagina)+  And + IntToStr(QtdDados)+ ;
     if ((Relacionamento <> ) and (Relacionamento <> EmptyStr)) then
      Begin
       if Length(vlWhere) > 7 then
        vlWhere := vlWhere +  and  +Relacionamento+ 
       else
        vlWhere := vlWhere + Relacionamento +  ;
      End;
     if ((Where <> ) and (Where <> EmptyStr)) then
      Begin
       if Length(vlWhere) > 7 then
        vlWhere := vlWhere +  and  +where+ 
       else
        vlWhere := vlWhere + where +  ;
      End;
     if ((OrderBy <> ) and (OrderBy <> EmptyStr)) then
       vlOrderBY :=  Order By + OrderBy;
     FCommandText := vlSelect;
     if Length(vlWhere) > 7 then
       FCommandText := FCommandText + vlWhere;
     FCommandText := FCommandText+ vlOrderBy;
     Result := True;
    End
   else
    begin
     ShowMessage(Informe os campos e Tabelas a serem consultados.);
     Exit;
    end;
Except
 Result := False;
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 ((Tabelas <> ) and (Tabelas <> EmptyStr) and (Campos <> ) and (Campos <> EmptyStr)) then
    Begin
     vlSelect := Select ;
     if DivideDados then
      begin
       if ((PrimaryKey <> ) and (PrimaryKey <> EmptyStr)) then
        vlSelect := vlSelect + Top (+ IntToStr(QtdDados)+) 
       else
        begin
         ShowMessage(O campo PrimaryKey não pode estar vazio);
         Exit;
        end;
      end;
     vlSelect := vlSelect + Campos +  From + Tabelas + ;
     if ((Relacionamento <> ) and (Relacionamento <> EmptyStr))  then
      vlWhere :=  Where + Relacionamento+  ;
     if DivideDados then
      Begin
       vlSubSelect := (+PrimaryKey+ not in ( select top(+ IntToStr(Pagina*QtdDados)+) + PrimaryKey +  from + Tabelas+ ;
       if vlWhere <> EmptyStr then
         vlSubWhere := vlWhere ;
       if ((Where <> ) and (Where <> EmptyStr)) then
        Begin
         if vlWhere <> EmptyStr then
          vlSubWhere := vlWhere +  and + Where
         Else
          vlSubWhere :=  Where + Where;
         //vlSubwhere := vlSubWhere +  and + Where +)) ;
        End;
        vlSubWhere   := )) ;
        if vlWhere <> EmptyStr then
          vlWhere := vlWhere +  and + vlSubSelect+ vlSubWhere
        else
          vlWhere :=  Where + vlSubSelect+ vlSubWhere;
      End;
     if ((Where <> ) and (Where <> EmptyStr)) then
      Begin
       if vlWhere <> EmptyStr then
        vlWhere := vlWhere +  and + Where +  
       Else
        vlWhere :=  Where + Where;
      End;
     if ((OrderBy <> ) and (OrderBy <> EmptyStr)) then
       vlOrderBY :=  Order By + OrderBy;
     FCommandText := vlSelect;
     if vlWhere <> EmptyStr then
       FCommandText := FCommandText + vlWhere;
     FCommandText := FCommandText+ vlOrderBy;
     Result := True;
    End
   else
    begin
     ShowMessage(Informe os campos e Tabelas a serem consultados.);
     Exit;
    end;
 Except
  Result := False;
 End;
end;

procedure TConsulta.SalvaOld;
begin
 OldTabelas              := FTabelas;     // Pego o Select atual e quardo na variavel para poder fazer outro select
 OldCampos               := FCampos;
 OldRelacionamento       := FJoin;
 OldWhere                := FWhere;
 OldPrimaryKey           := FPrimaryKey;
 OldOrderBy              := FOrderBy;
 OldQtdDados             := FQtdDados;
 OldPagina               := FPagina;
 OldDivideDados          := FDivideDados;
end;

procedure TSQLDataSetRpz.SetAtivo(const Value: Boolean);
begin
  FAtivaConsulta := Value;
  if FAtivaConsulta then
   Begin
    Consulta.MontaSelect(Self)
   End;
      FAtivaConsulta := False;
  //TWinControl(GetOwner).Invalidate;
end;

procedure TSQLDataSetRpz.SetChild(const Value: Boolean);var
 vlCds : TClientDataSetRpz;
 vlDsp : TDataSetProviderRpz;
begin
  FChild                    := Value;
  if Value then
   begin
    vlDsp                   := TDataSetProviderRpz.Create(OWNER);
    with vlDsp do
     Begin
      DataSet               := Self;
      Name                  := dsp+Copy(Self.Name, 4, length(self.Name));   //Aqui que não seu pegar e definir o left e o Top
     End;
    vlCds                   := TClientDataSetRpz.Create(OWNER);
    with vlCds do
     Begin
      Consulta              := self.Consulta;
      ProviderName          := vlDsp.Name;
      SQLConnection         := Self.SQLConnection;
      Name                  := cds+Copy(Self.Name, 4, length(self.Name));
      CommandText           := Self.CommandText;  //Aqui que não seu pegar e definir o left e o Top
     End;
   end;
end;

procedure TClientDataSetRpz.SetAtivo(const Value: Boolean);
begin
  FAtivaConsulta := Value;
  if FAtivaConsulta then
   Begin
     Consulta.MontaSelect(Self)
   End;
      FAtivaConsulta := False;
  //TWinControl(GetOwner).Invalidate;
end;

procedure TClientDataSetRpz.SetSQLConnection(const Value: TSQLConnection);
begin
  FSQLConnection := Value;
end;

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

{ TClientDataSetFre }

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

destructor TClientDataSetRpz.Destroy;
begin
  FreeAndNil(FConsulta);
  inherited Destroy;
end;

constructor TDataSetProviderRpz.Create(Aowner: TComponent);
begin
  inherited Create(Aowner);
  UpdateMode      := upWhereChanged;
  Options         := [poFetchDetailsOnDemand,poIncFieldProps,poAutoRefresh,poPropogateChanges,poAllowCommandText,poUseQuoteChar];

end;

destructor TDataSetProviderRpz.Destroy;
begin
  inherited Destroy;
end;

end.
Responder

Gostei + 0

31/01/2012

Tiago Soares

Adm desculpa mas esta bugando o código poderias deletar os posts anteriores.

unit DBRpZ;

interface

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

////////////////////////////////////////////////////////////////////////////////
/// 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;

////////////////////////////////////////////////////////////////////////////////
/// SqlDataSet
////////////////////////////////////////////////////////////////////////////////

type
TSQLDataSetRpz = class(TSQLDataSet)
private
FConsulta : TConsulta;
FAtivaConsulta : Boolean;
FChild : Boolean;
procedure SetAtivo(const Value: Boolean);
procedure SetChild(const Value: Boolean);
{ Private declarations }
protected
{ Protected declarations }
public
Constructor Create(Aowner:TComponent); Override;
Destructor Destroy; Override;
{ Public declarations }
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 True;

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
FConsulta : TConsulta;
FSQLConnection : TSQLConnection;
FAtivaConsulta : Boolean;
procedure SetAtivo(const Value: Boolean);
procedure SetSQLConnection(const Value: TSQLConnection);
Protected

public
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 SQLConnection : TSQLConnection read FSQLConnection write SetSQLConnection;

end;

procedure Register;

implementation

procedure TConsulta.Assign(Source: TPersistent);
begin
inherited;
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;
Exit;
end;
inherited Assign(Source);
end;

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

destructor TSQLDataSetRpz.Destroy;
begin
FreeAndNil(FConsulta);
inherited Destroy;
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
Begin
Conexao := TSQLDataSetRpz(sender).SQLConnection;
End
else if sender is TClientDataSetRpz then
Begin
Conexao := TClientDataSetRpz(sender).SQLConnection;
End;
if Assigned(Conexao) then
Begin
if ((Conexao.ConnectionName <> EmptyStr) and (Conexao.ConnectionName <> ) and (Conexao.DriverName <> ) and (Conexao.DriverName <> EmptyStr)) then
Begin
if ((Conexao.VendorLib <> ) and (Conexao.VendorLib <> EmptyStr)) then
Begin
if pos(OCI, UpperCase(Conexao.VendorLib))> 0 then
Begin
Result := MontaSelectOracle
End
Else if pos(GDS32, UpperCase(Conexao.VendorLib))> 0 then
Begin
Result := MontaSelectFirebird;
End
Else if pos(SQLOLEDB, UpperCase(Conexao.VendorLib)) > 0 then
Begin
Result := MontaSelectSqlServer;
End
Else
Result := False;
End;
End;
End
Else
begin
ShowMessage(Não existe conexão com o banco configurado.);
Exit;
end;

if Result then
Begin
if sender is TSQLDataSetRpz then
Begin
TSQLDataSetRpz(sender).SetCommandText(FCommandText);
End
else if sender is TClientDataSetRpz then
begin
TClientDataSetRpz(sender).SetCommandText(FCommandText);
End;
End
Else
ShowMessage(Erro ao gerar a consulta.);
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 ((Tabelas <> ) and (Tabelas <> EmptyStr) and (Campos <> ) and (Campos <> EmptyStr)) then
Begin
vlSelect := Select ;
if DivideDados then
vlSelect := vlSelect +First +IntToStr(QtdDados)+ skip + IntToStr(Pagina * QtdDados)+ ;
vlSelect := vlSelect + Campos + From + Tabelas + ;
vlWhere := Where ;
if ((Relacionamento <> ) and (Relacionamento <> EmptyStr)) then
vlWhere := vlWhere + Relacionamento+ ;
if ((Where <> ) and (Where <> EmptyStr)) then
Begin
if Length(vlWhere) > 7 then
vlWhere := vlWhere + and + Where
else
vlWhere := vlWhere + Where;
End;
if ((OrderBy <> ) and (OrderBy <> EmptyStr)) then
vlOrderBY := Order By + OrderBy;
FCommandText := vlSelect;
if Length(vlWhere) > 7 then
FCommandText := FCommandText + vlWhere;
FCommandText := FCommandText+ vlOrderBy;
Result := True;
End
else
begin
ShowMessage(Informe os campos e Tabelas a serem consultados.);
Exit;
end;
Except
Result := False;
End;
end;

function TConsulta.MontaSelectOracle: Boolean;
var
vlSelect,
vlWhere,
vlOrderBY : AnsiString;
begin
Try
Result := False;
if ((Tabelas <> ) and (Tabelas <> EmptyStr) and (Campos <> ) and (Campos <> EmptyStr)) then
Begin
vlSelect := Select ;
vlSelect := vlSelect + Campos + From + Tabelas + ;
vlWhere := Where ;
if DivideDados then
vlWhere := vlWhere +RowNum between +IntToStr(Pagina)+ And + IntToStr(QtdDados)+ ;
if ((Relacionamento <> ) and (Relacionamento <> EmptyStr)) then
Begin
if Length(vlWhere) > 7 then
vlWhere := vlWhere + and +Relacionamento+
else
vlWhere := vlWhere + Relacionamento + ;
End;
if ((Where <> ) and (Where <> EmptyStr)) then
Begin
if Length(vlWhere) > 7 then
vlWhere := vlWhere + and +where+
else
vlWhere := vlWhere + where + ;
End;
if ((OrderBy <> ) and (OrderBy <> EmptyStr)) then
vlOrderBY := Order By + OrderBy;
FCommandText := vlSelect;
if Length(vlWhere) > 7 then
FCommandText := FCommandText + vlWhere;
FCommandText := FCommandText+ vlOrderBy;
Result := True;
End
else
begin
ShowMessage(Informe os campos e Tabelas a serem consultados.);
Exit;
end;
Except
Result := False;
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 ((Tabelas <> ) and (Tabelas <> EmptyStr) and (Campos <> ) and (Campos <> EmptyStr)) then
Begin
vlSelect := Select ;
if DivideDados then
begin
if ((PrimaryKey <> ) and (PrimaryKey <> EmptyStr)) then
vlSelect := vlSelect + Top (+ IntToStr(QtdDados)+)
else
begin
ShowMessage(O campo PrimaryKey não pode estar vazio);
Exit;
end;
end;
vlSelect := vlSelect + Campos + From + Tabelas + ;
if ((Relacionamento <> ) and (Relacionamento <> EmptyStr)) then
vlWhere := Where + Relacionamento+ ;
if DivideDados then
Begin
vlSubSelect := (+PrimaryKey+ not in ( select top(+ IntToStr(Pagina*QtdDados)+) + PrimaryKey + from + Tabelas+ ;
if vlWhere <> EmptyStr then
vlSubWhere := vlWhere ;
if ((Where <> ) and (Where <> EmptyStr)) then
Begin
if vlWhere <> EmptyStr then
vlSubWhere := vlWhere + and + Where
Else
vlSubWhere := Where + Where;
//vlSubwhere := vlSubWhere + and + Where +)) ;
End;
vlSubWhere := )) ;
if vlWhere <> EmptyStr then
vlWhere := vlWhere + and + vlSubSelect+ vlSubWhere
else
vlWhere := Where + vlSubSelect+ vlSubWhere;
End;
if ((Where <> ) and (Where <> EmptyStr)) then
Begin
if vlWhere <> EmptyStr then
vlWhere := vlWhere + and + Where +
Else
vlWhere := Where + Where;
End;
if ((OrderBy <> ) and (OrderBy <> EmptyStr)) then
vlOrderBY := Order By + OrderBy;
FCommandText := vlSelect;
if vlWhere <> EmptyStr then
FCommandText := FCommandText + vlWhere;
FCommandText := FCommandText+ vlOrderBy;
Result := True;
End
else
begin
ShowMessage(Informe os campos e Tabelas a serem consultados.);
Exit;
end;
Except
Result := False;
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;

procedure TSQLDataSetRpz.SetAtivo(const Value: Boolean);
begin
FAtivaConsulta := Value;
if FAtivaConsulta then
Begin
Consulta.MontaSelect(Self)
End;
FAtivaConsulta := False;
//TWinControl(GetOwner).Invalidate;
end;

procedure TSQLDataSetRpz.SetChild(const Value: Boolean);var
vlCds : TClientDataSetRpz;
vlDsp : TDataSetProviderRpz;
begin
FChild := Value;
if Value then
begin
vlDsp := TDataSetProviderRpz.Create(OWNER); // Crio o Provider e vinculo com o SqlDataSet
with vlDsp do
Begin
DataSet := Self;
Name := dsp+Copy(Self.Name, 4, length(self.Name)); // Aqui não sei definir Left e top
End;
vlCds := TClientDataSetRpz.Create(OWNER); //Crio o Cds configuro e vinculo com o Provider.
with vlCds do
Begin
Consulta := self.Consulta;
ProviderName := vlDsp.Name;
SQLConnection := Self.SQLConnection;
Name := cds+Copy(Self.Name, 4, length(self.Name));
CommandText := Self.CommandText; // Aqui não sei definir Left e top

End;
end;
end;

procedure TClientDataSetRpz.SetAtivo(const Value: Boolean);
begin
FAtivaConsulta := Value;
if FAtivaConsulta then
Begin
Consulta.MontaSelect(Self) //Mando Criar a consulta
End;
FAtivaConsulta := False;
//TWinControl(GetOwner).Invalidate;
end;

procedure TClientDataSetRpz.SetSQLConnection(const Value: TSQLConnection);
begin
FSQLConnection := Value;
end;

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

{ TClientDataSetFre }

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

destructor TClientDataSetRpz.Destroy;
begin
FreeAndNil(FConsulta);
inherited Destroy;
end;

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

end;

destructor TDataSetProviderRpz.Destroy;
begin
inherited Destroy;
end;

end.
Responder

Gostei + 0

31/01/2012

Emerson Nascimento

fiz algumas mudanças (estou sem o Deplhi, fiz no bloco de notas, então pode dar algum erro de sintaxe):

unit DBRpZ;

interface

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

////////////////////////////////////////////////////////////////////////////////
/// 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
FConsulta : TConsulta;
FSQLConnection : TSQLConnection;
FAtivaConsulta : Boolean;

procedure SetAtivo(const Value: Boolean);
procedure SetSQLConnection(const Value: TSQLConnection);
protected
public
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 SQLConnection : TSQLConnection read FSQLConnection write SetSQLConnection;
end;

////////////////////////////////////////////////////////////////////////////////
/// SqlDataSet
////////////////////////////////////////////////////////////////////////////////
type
TSQLDataSetRpz = class(TSQLDataSet)
private
{ Private declarations }
FConsulta : TConsulta;
FProviderRpz : TDatasetProviderRpz;
FClientRpz : 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 True;
end;

procedure Register;

implementation

procedure TConsulta.Assign(Source: TPersistent);
begin
inherited;

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).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
Result := False;
End;
End;
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
Else
ShowMessage(Erro ao gerar a consulta.);
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 := FWhere ;

if (FRelacionamento <> 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
ShowMessage(Informe os campos e Tabelas a serem consultados.);
Except
Result := False;
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 (FRelacionamento <> EmptyStr) then
Begin
if Length(vlWhere) > 7 then
vlWhere := vlWhere + and +FRelacionamento+
else
vlWhere := vlWhere + FRelacionamento + ;
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
ShowMessage(Informe os campos e Tabelas a serem consultados.);
Except
Result := False;
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 (FRelacionamento <> EmptyStr) then
vlWhere := Where + FRelacionamento+ ;

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;
//vlSubwhere := vlSubWhere + and + 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
ShowMessage(Informe os campos e Tabelas a serem consultados.);
Except
Result := False;
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;
FConsulta.QtdDados := 50;
FConsulta.OrderBy := 1;
end;

destructor TSQLDataSetRpz.Destroy;
begin
FreeAndNil(FConsulta);
inherited Destroy;
end;

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

procedure TSQLDataSetRpz.SetChild(const Value: Boolean);
begin
FChild := Value;
if FChild then
begin
if not Assigned(FProviderRpz) then
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;

if not Assigned(FClientRpz) then
FClientRpz := TClientDataSetRpz.Create(OWNER); //Crio o Cds configuro e vinculo com o Provider.

with FClientRpz do
Begin
Consulta := self.Consulta;
ProviderName := FProviderRpz.Name;
SQLConnection := Self.SQLConnection;
Name := cds+Copy(Self.Name, 4, length(self.Name));
CommandText := Self.CommandText; // Aqui não sei definir Left e top
End;
end;
end;

{ TClientDataSetRpz }

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

destructor TClientDataSetRpz.Destroy;
begin
FreeAndNil(FConsulta);
inherited Destroy;
end;

procedure TClientDataSetRpz.SetSQLConnection(const Value: TSQLConnection);
begin
FSQLConnection := Value;
end;

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

{ TDataSetProviderRpz }

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

destructor TDataSetProviderRpz.Destroy;
begin
inherited Destroy;
end;


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

end.
Responder

Gostei + 0

01/02/2012

Tiago Soares

Obrigado pela ajuda deu uma boa melhorada no código e tb ja dei uma ajeitada no codigo mas ainda tenho a duvida d como pegar o left e o Top para setar nos outros componentes.
aguardando
Responder

Gostei + 0

01/02/2012

Tiago Soares

Um problema tb que estou tendo é quando deleto o sqlconnection da access violation no delphi e some o vinculo do sqlconnection do clientdataset
Responder

Gostei + 0

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar