Desenvolvimento - Delphi

Desenvolvendo FrameWork em Delphi

Este artigo vai mostrar como criar e implementar algumas classes que vão formar um framework que poderá ser implementado em softwares orientados a eventos quanto a objetos

por Alexandre Telles Estanieski



Saudações, pessoal! Este artigo vai mostrar como criar e implementar algumas classes que vão formar um framework que poderá ser implementado em softwares orientados a eventos quanto a objetos. Primeiro temos que entender o que significa framework.

“Framework é um conjunto de classes que colaboram para realizar uma responsabilidade para um domínio de um subsistema da aplicação.”

— Fayad e Schmidt,


Bom partindo desse princípio, teremos que criar algumas classes em nosso pequeno FrameWork, neste artigo iremos criar somente duas classes que poderemos fazer muita coisa com elas, claro que elas serão a ponta do IceBerg de algo bem maior que podemos implementar, vamos Criar essas classes:

Modelagem das Classes ClassSql e ClassList

Figura 1. Modelagem das Classes ClassSql e ClassList

Descritivo:

ClassSql: Vamos implementar as regras de negócio para comunicação com o banco de dados(neste caso Firebird) essa classe realizará: Select, Insert, Update entre outros procedimentos.

ClassList: Essa classe criará Listas encadeadas(leia mais neste link) que carregarão na memória os dados pesquisados na ClassSql.

Vamos implementar conforme mostra abaixo:

Menu Delphi: File->New->Unit

Será aberta uma Unit limpa, desta forma:

Unit  Unit2;
     interface
     implementation
end.

Re-escreva assim:

Listagem: Head da classe com declarações de variáveis e métodos construtores

unit ClassSQL;
interface
  uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,SqlExpr, DBClient, Provider, DBXpress,ClassList,
  Mask, ToolEdit, jpeg, DB, DBTables, RlReport, ClassUtilitarios;


type TClassSQL = class
  private
    FQuery: TSQLQuery;
    IsFQueryOpen: Boolean;
    FClientDataSet:TClientDataSet;
    FDataSetProvider:TDataSetProvider;
//    function  VerifyListObject_(ComboBoxList: TUtilComboList): string;Overload;
  public

    FUtilList:TclassList;
    TTableName: string;
    TIdPkFieldName,TIdFkFieldName: string;    TIdPk: Integer;
    TIDPK_FK:string;
    TIdFieldValue:string;
    TDataBase:TSQLConnection;
    Q: TSqlQuery;

    FTd: TTransactionDesc;
    DataModule:TDataModule;

    constructor CreateSQL(TableName:string; Id:integer; 
IdFieldName:string;Base:TSqlConnection);
    public constructor CreateOpenQuery(custom_sql: string);

Listagem: Declarações de procedimentos para ADICIONAR valores na LISTA que será executada no SQL,adiciona-se valores conforme o tipo de registro.

    public procedure AddIntegerField(field_name: string; field_value: Integer);
    public procedure AddIntegerFkField(field_name: string; field_value: Integer);
    public procedure AddStringField(field_name: string; field_value: string);
    public procedure AddDateField(field_name: string; field_value: TDate);
    public procedure AddTimeField(field_name: string; field_value: TTime);
    public procedure AddDoubleField(field_name: string; field_value: Double);
    public procedure AddBooleanField(field_name: string; field_value: Boolean);
    public procedure AddOptionField(field_name: string; field_value: string);

Listagem: Metódos que chamam as montagens e execuções dos scritps SQL[Insert, UpDate]

 
Public function ExecuteInsert:integer;
    Public function ExecuteSimpleInsert:integer;
    Public function ExecuteUpdate:boolean;Virtual;
    Public Function ExecuteUpdateNoWhere:Boolean;
    Public function ExecuteDelete:boolean;
    Public function ExecuteBeforeDelete:Boolean;
    public Function ExecuteBeforeDeleteTwoFields(IndexField1, 
IndexField2:string;IndexValue1, indexValue2:Integer):boolean;

Listagem: Procedimentos para Abrir pesquisas através de scripts SQL, e métodos para varrer a tabela aberta.

    procedure OpenTable;
    procedure OpenTableSimple;
    Function  OpenSetValue(FieldMaster:string;IdMaster, IdIndex:integer):string;
    Public procedure Next;
    Public procedure First;
    public function EofTable:Boolean;

Listagem: Metódos de Get, para buscar na tabela valores para campos específicos, funcionam como fieldbyname.

public function  GetRecordCount:integer;
    public function  GetIsNotEmpty:Boolean;
    public function  GetId(Field:string):integer;
    public function  GetId2(Field:string):integer;
    public function  GetList:TClassList;
    public function  GetSelectId(FieldIdFk, FieldIdFk2, FieldValue:string;IdFk, 
IdFk2, Value:integer): integer;

    public function GetField(Field:string):TField;
    public function GetField2(Field:string):TField;
    public function GetQry:TClientDataSet;    

Listagem: Selects para pesquisas, também fechamento e abertura de transações no banco de dados atrás de Commit e Start

    Public Function  SelectOpenStringValue(Value, FieldSearch, 
FieldResult:string):integer;
    Public procedure SelectOpenSetValue(Cb:TComboBox;Data:TDateEdit;FieldSearch,
FieldSearch2, FieldId:string; IDPK:integer);
    Public procedure SelectOpen(Value:string);Overload;
    Public procedure SelectOpenSql(Sql:string);
    Public procedure SelectOpenReturnString;
    function         SelectOpenStringReturnInteger(Value, 
FieldResult,FieldSearch:string):integer;

    Public Procedure StartTransaction;
    Public Procedure CommitTransaction;

    public function  RecordCount: Integer;
    public procedure ReturnGenerator(Gen:string;Value:Integer);
    public procedure LoadListObject_(Img:TImage;Field:string);Overload;
    public procedure LoadListObject_(Img:TRlImage;Field:string);Overload;

Listagem: Implementação completa da Classe

implementation

uses database;

{ TClassSql }


var FUtilSql:TclassSql;


function TClassSQL.ExecuteDelete: Boolean;
begin
//  ExecuteBeforeDelete;
  Result:=True;
  q := TSqlQuery.Create(nil);
  q.SQLConnection := TDataBase;
  q.SQL.Text:='DELETE FROM ' + TTableName + ' WHERE (' + 
  TTableName + '.' + TIdPkFieldName + ' = ' + IntToStr(TIdPk) + ')';
  try
    StartTransaction;
    q.ExecSQL;
    CommitTransaction;
  except
    Result := False;
  end;
  q.Free;

end;

procedure TClassSQL.SelectOpen(Value: string);
begin
  q := TSqlQuery.Create(nil);
  q.SQLConnection := TDataBase;
  q.SQL.Text:='Select * from ' + TTableName + ' WHERE (' + 
  TTableName + '.' + TIdFieldValue + ' = ' + IntToStr(TIdPk) + ')';
  try
    q.Open;
    TIdPk:=q.fieldbyname(TIdFieldValue).AsInteger;
  except
   q.Free
  end;


end;

procedure TClassSQL.SelectOpenReturnString;
begin
  q := TSqlQuery.Create(nil);
  q.SQLConnection := TDataBase;
  q.SQL.Text:='Select * from ' + TTableName + ' WHERE (' + 
  TTableName + '.' + TIdPkFieldName + ' = ' + IntToStr(TIdPk) + ')';
  try
    q.Open;
    TIdFieldValue:=q.fieldbyname(TIDPK_FK).ASString;
    q.Free;
  except
   q.Free
  end;
end;

procedure TClassSQL.OpenTable;

begin
  q := TSqlQuery.Create(nil);
  q.SQLConnection := TDataBase;
  q.SQL.Text:='Select * from ' + TTableName + ' WHERE (' + TTableName + '.'
                 + TIdPkFieldName + ' = ' + IntToStr(TIdPk) + ')';
  try
    q.Open;
  FClientDataSet:=TClientDataSet.Create(nil);
  FDataSetProvider:=TDataSetProvider.Create(nil);
    FDataSetProvider.DataSet:=q;
    FClientDataSet.SetProvider(FDataSetProvider);
  except
    q.Free
  end;
end;

procedure TClassSQL.DestroyTable;
begin
  if q<>nil then
    Q.Free;
  if FQuery<>nil then
    FQuery.Free;
end;

function TClassSQL.ListTableReturnField(Field: String): string;
begin
      Result:=Q.fieldbyname(Field).AsString;
end;

procedure TClassSQL.OpenTableSimple;
begin
  FClientDataSet:=TClientDataSet.Create(nil);
  FDataSetProvider:=TDataSetProvider.Create(nil);
  q := TSqlQuery.Create(nil);  

  q.SQLConnection := TDataBase;
  q.SQL.Text:='Select * from ' + TTableName;
  try
    q.Open;
    FClientDataSet.SetProvider(FDataSetProvider);
    FDataSetProvider.DataSet:=q;
    FClientDataSet.Active:=True; 
  except
    q.Free
  end;
end;

function TClassSQL.GetRecordCount: integer;
var Count:integer;
begin
 //
end;

function TClassSQL.GetId(Field: string): integer;
begin
  Result:=Q.fieldbyname(field).AsInteger;
end;

function TClassSQL.SelectOpenStringValue(Value, 
FieldSearch, FieldResult: string): integer;
begin
  q := TSqlQuery.Create(nil);
  q.SQLConnection := TDataBase;
  q.SQL.Text:='Select * from ' + TTableName + ' WHERE (' + TTableName + '.'
                 + FieldSearch + ' = ''' + Value + ''')';
  try
    q.Open;
    Result:=q.fieldbyname(FieldResult).asinteger;
  except
    q.Free
  end;
end;

procedure TClassSQL.SelectOpenSetValue(Cb:TComboBox;Data:TDateEdit;
FieldSearch,FieldSearch2, FieldId:string; IDPK:integer);
begin
    OpenSetValue(FieldId, IdPk,1 );
    if (Cb<>nil) and (FieldSearch<>'') then
      Cb.ItemIndex:=Cb.Items.IndexOf(q.fieldbyname(FieldSearch).asstring);
    if (Data<>Nil) and ( FieldSearch2<>'') then
      Data.date:=Q.fieldbyname(FieldSearch2).asdatetime;
end;

Function TClassSQL.OpenSetValue(FieldMaster:string;IdMaster, 
IdIndex:integer):string;
begin
  q := TSqlQuery.Create(nil);
  q.SQLConnection := TDataBase;
  q.SQL.Text:='Select * from ' + TTableName + ' WHERE (' + TTableName + '.'
                 + TIdFieldValue + ' = ' + IntToStr(TIdPk) + ') and ('+ TTableName + '.'
                 + FieldMaster + ' = ' + IntToStr(IdMaster) + ')';
  try
    q.Open;
    Result:=q.FieldList.Fields[IdIndex].ASstring;
  except
   q.Free
  end;

end;


function TClassSQL.GetSelectId(FieldIdFk, 
FieldIdFk2, FieldValue:string;IdFk, IdFk2, 
Value:integer): integer; 
var
  i, r: Integer;
  sql: string;
  TableName:string;
  Base:TSQLConnection;
begin
  q := TSqlQuery.Create(nil);
  q.SQLConnection := TDataBase;
  q.SQL.Text:='Select * from ' + TTableName + ' WHERE (' + TTableName + '.'
                 + FieldIdFk + ' = ' + IntToStr(IdFk) + ') and ('+ TTableName + '.'
                 + FieldIdFk2 + ' = ' + IntToStr(IdFk2) + ') and ('+ TTableName + '.'
                 + FieldValue + ' = ' + IntToStr(Value) + ')';

    q.Open;
    Result:=q.FieldList.Fields[0].AsInteger;
    q.Free;
end;

procedure TClassSQL.CommitTransaction;
begin
   try
     TDataBase.Commit(FTd);
   except
      TDataBase.Rollback(FTd);
   end;

end;

procedure TClassSQL.StartTransaction;
begin
    try
    FTd.TransactionID := 1;
    FTd.IsolationLevel := xilREADCOMMITTED;
    //Inicia a transação
    TDataBase.StartTransaction(FTd);
   except
    TDataBase.Rollback(FTd);
   end;
end;

function TClassSQL.ExecuteBeforeDelete: Boolean;
begin
  Result:=True;
  q := TSqlQuery.Create(nil);
  q.SQLConnection := TDataBase;
  q.SQL.Text:='DELETE FROM ' + TTableName + ' WHERE (' + TTableName + '.'
                 + TIdPkFieldName + ' = ' + IntToStr(TIdPk) + ')';
  try
    StartTransaction;
    q.ExecSQL;
    CommitTransaction
  except
    Result := False;
  end;
  q.Free;

end;



constructor TClassSQL.CreateOpenQuery(custom_sql: string);
begin
  if FQuery=nil then begin
    FQuery := TSQlQuery.Create(nil);
    FQuery.SQLConnection := Base.Base_;
  end;
  FQuery.close;
  FQuery.SQL.clear;
  FQuery.SQL.Text := custom_sql;
  FQuery.Open;
  IsFQueryOpen := True;
end;

function TClassSQL.RecordCount: Integer;
begin
  Result := FQuery.fieldbyname('Field').asinteger;
end;



function TClassSQL.SelectOpenStringReturnInteger(Value, 
FieldResult,FieldSearch:string): integer;
begin
  q := TSqlQuery.Create(nil);
  q.SQLConnection := TDataBase;
  q.SQL.Text:='Select * from ' + TTableName + ' WHERE (' + TTableName + '.'
                 + FieldSearch + ' = ''' + Value + ''')';
  try
    q.Open;
    Result:=q.fieldbyname(FieldResult).asinteger;
    q.Free;    
  except
    q.Free
  end;
end;

function TClassSQL.ListTableReturnField2(Field: String): string;
begin
  Result:=FQuery.fieldbyname(Field).AsString;
end;

function TClassSQL.GetIsNotEmpty: Boolean;
begin
  Result:=False;
  if FQuery <> nil then begin
    if not FQuery.IsEmpty then
      Result:=True;
  end else
  if Q <> nil then begin
    if not Q.IsEmpty then
      Result:=True;
  end;
end;

procedure TClassSQL.ReturnGenerator(Gen:string;Value: Integer);
begin
//  StartTransaction;
  Q := TSQLQuery.Create(nil);
  Q.SQLConnection := TDataBase;
  Q.close;
  Q.sql.clear;
  Q.sql.text:='Set generator '+Gen+' to '+Inttostr(Value);
  Q.ExecSQL;
 // CommitTransaction;
end;


function TClassSQL.GetList: TClassList;
begin
  Result:=FUtilList;
end;

function TClassSQL.GetId2(Field: string): integer;
begin
  Result:=FQuery.fieldbyname(field).AsInteger;
end;

procedure TClassSQL.LocateValueField(Value, Field: String);
begin
  FQuery.Locate(field,Value,[]);
end;






procedure TClassSQL.LoadListObject_(Img: TImage; Field: string);
var
  msBMP: TBitmap;
  msJPG: TJPEGImage;
  BlobStream : TStream;
begin
  //BlobStream := TBlobStream.Create(Q.fieldbyname(Field) as TBlobField, bmRead);
  BlobStream:=Q.CreateBlobStream(Q.FieldByName(Field),bmRead);
  if BlobStream.Size > 0 then begin
     try
      msJPG := TJpegImage.Create;
      msJPG.LoadFromStream(BlobStream);
      Img.Picture.Assign(msJPG);
      except
      msBMP := TBitmap.Create;
      msBMP.LoadFromStream(BlobStream);
      Img.Picture.Assign(msBMP);
      end;
      Img.Repaint;
  end;
{  if msBMP  then
    msBMP.Free;
  if not msJPG.Empty then
    msJPG.Free;}
end;

function TClassSQL.GetField(Field:string): TField;
begin
  Result:=Q.fieldbyname(Field);
end;

procedure TClassSQL.LoadListObject_(Img: TRlImage; Field: string);
var
  msBMP: TBitmap;
  msJPG: TJPEGImage;
  BlobStream : TStream;
begin
  //BlobStream := TBlobStream.Create(Q.fieldbyname(Field) as TBlobField, bmRead);
  BlobStream:=Q.CreateBlobStream(Q.FieldByName(Field),bmRead);
  if BlobStream.Size > 0 then begin
     try
      msJPG := TJpegImage.Create;
      msJPG.LoadFromStream(BlobStream);
      Img.Picture.Assign(msJPG);
      except
      msBMP := TBitmap.Create;
      msBMP.LoadFromStream(BlobStream);
      Img.Picture.Assign(msBMP);
      end;
      Img.Repaint;
  end;

end;



procedure TClassSQL.LocateValueField_(Value, field: String);
begin
     Q.Locate(field,Value,[]);
end;


function TClassSQL.ExecuteUpdateNoWhere: Boolean;
var Sql: string;
    q:TSQLQuery;
    i:integer;
begin

  Result:=True;
  sql := 'UPDATE ' + TTableName + ' SET ';
  for i := 0 to FUtilList.Count-1 do begin
    sql := sql + ' ' + FUtilList.GetStringKey(i) + ' = ' + FUtilList.GetItem(i);
    if i <> FUtilList.Count-1 then
      sql := sql + ',';
  end;
  q := TSQLQuery.Create(nil);
  q.SQLConnection := TDataBase;
  q.SQL.Text := sql;

  try
    q.ExecSQL;
  except
  Result:=False;
  end;
  q.Free;
  Result:=False;

end;





function TClassSQL.GetField2(Field: string): TField;
begin
  Result:=FQuery.fieldbyname(Field);
end;



procedure TClassSQL.Next;
begin
if FQuery <> nil then
    FQuery.next;
  if Q <> nil then
    Q.next;
end;

procedure TClassSQL.First;
begin
if FQuery <> nil then
    FQuery.First;
  if Q <> nil then
    Q.first;
end;

procedure TClassSQL.SelectOpenSql(Sql: string);
begin
  q := TSqlQuery.Create(nil);
  q.SQLConnection := TDataBase;
  q.SQL.Text:=Sql;
  try
    q.Open;
  except
   q.Free
  end;

end;

function TClassSQL.ExecuteSimpleInsert: integer;
var
  i, r: Integer;
  sql: string;
  TableName:string;
  Base:TSQLConnection;
  x,y:TSQLQuery;
begin
        sql := '';
        sql := sql + 'INSERT INTO ' + TTableName + ' (';
        for i := 0 to FUtilList.Count-1 do begin
          sql := sql + ' ' + FUtilList.GetStringKey(i);
          if i <> FUtilList.Count-1 then
            sql := sql + ',';
        end;
        sql := sql + ') VALUES(';
        for i := 0 to FUtilList.Count-1 do begin
          sql := sql + ' ' + FUtilList.GetItem(i);
          if i <> FUtilList.Count-1 then
            sql := sql + ',';
        end;
        sql := sql + ')';


        q := TSQLQuery.Create(nil);
        q.SQLConnection := TDataBase;

        FClientDataSet:=TClientDataSet.Create(nil);
        FDataSetProvider:=TDataSetProvider.Create(nil);
        FClientDataSet.SetProvider(FDataSetProvider);
        FDataSetProvider.DataSet:=q;
        q.SQL.Text := sql;
        q.ExecSQL;
        q.free;
end;

function TClassSQL.EofTable:Boolean;
begin
  Result:=False;
  if FQuery <> nil then begin
     if FQuery.eof then
      Result:=True;
  end;
  if Q <> nil then begin
     if Q.eof then
      Result:=true
  end;
end;

function TClassSQL.ExecuteBeforeDeleteTwoFields(IndexField1,
  IndexField2: string; IndexValue1, indexValue2: Integer): boolean;
begin
  Result:=True;
  q := TSqlQuery.Create(nil);
  q.SQLConnection := TDataBase;
  q.SQL.Text:='DELETE FROM ' + TTableName + ' WHERE 
      (' + TTableName + '.'
      + IndexField1 + ' = ' + IntToStr(IndexValue1) + ' and '+TTableName + '.'
      + IndexField2 + ' = ' + IntToStr(IndexValue2) +')';
  try
    StartTransaction;
    q.ExecSQL;
    CommitTransaction
  except
    Result := False;
  end;
  q.Free;

end;

function TClassSQL.GetQry: TClientDataSet;
begin
  Result:=FClientDataSet;
end;

{ TClassSQL }

procedure TClassSQL.AddBooleanField(field_name: string;
  field_value: Boolean);
begin
 if field_value then
    FUtilList.Add(field_name, QuotedStr(  'S'))
    else
    FUtilList.Add(field_name, QuotedStr('N'));
end;

procedure TClassSQL.AddDateField(field_name: string;
  field_value: TDate);
begin
 FUtilList.Add(field_name, QuotedStr(FormatDateTime('mm/dd/yyyy',field_value)));
end;

procedure TClassSQL.AddDoubleField(field_name: string;
  field_value: Double);
begin
  FUtilList.Add(field_name, DoubleForSql(field_value));
end;
procedure TClassSQL.AddIntegerField(field_name: string;
  field_value: Integer);
begin
  if (Copy(field_name, 0,2) = 'Id') and (field_value = 0) then
    FUtilList.Add(field_name, 'NULL')
   else
    FUtilList.Add(field_name, IntegerForSql(field_value));
end;

procedure TClassSQL.AddIntegerFkField(field_name: string;
  field_value: Integer);
begin
  if field_value = 0 then
    FUtilList.Add(field_name, 'NULL')
   else
    FUtilList.Add(field_name, IntegerForSql(field_value));
end;

procedure TClassSQL.AddOptionField(field_name, field_value: string);
begin
  FUtilList.Add(field_name, QuotedStr(field_value));
end;

procedure TClassSQL.AddStringField(field_name, field_value: string);
begin
  FUtilList.Add(field_name, QuotedStr(field_value));
end;

procedure TClassSQL.AddTimeField(field_name: string;
  field_value: TTime);
begin
  FUtilList.Add(field_name, QuotedStr(TimeToStr(field_value)));
end;

constructor TClassSQL.CreateSQL(TableName:string;

Id:integer; IdFieldName:string;Base:TSqlConnection);

begin
  FUtilList:=TClassList.Create;
  TTableName:=TableName;
  TIdPk:=id;
  TIdPkFieldName:=IdFieldName;
  TIdFieldValue:=IdFieldName;
  TDataBase:=Base;

end;
function TClassSQL.ExecuteUpdate:boolean;
var
  I: Integer;
  Sql: string;
begin

  Result:=True;
  sql := 'UPDATE ' + TTableName + ' SET ';
  for i := 0 to FUtilList.Count-1 do begin
    sql := sql + ' ' + FUtilList.GetStringKey(i) + ' = ' + FUtilList.GetItem(i);
    if i <> FUtilList.Count-1 then
      sql := sql + ',';
  end;
  sql := sql + ' WHERE (' + TTableName + '.'
             + TIdPkFieldName + ' = ' + IntToStr(TIdPk) + ')';
  q := TSQLQuery.Create(nil);
  q.SQLConnection := TDataBase;
  q.SQL.Text := sql;

  try
    q.ExecSQL;
  except
  Result:=False;
  end;
  q.Free;
  Result:=False;
end;
function TClassSQL.ExecuteInsert:integer;
var
  i, r: Integer;
  sql: string;
  TableName:string;
  Base:TSQLConnection;
  x,y:TSQLQuery;
begin
//   if ValidateInsert=True then begin
        sql := '';
        sql := sql + 'INSERT INTO ' + TTableName + ' (';
        for i := 0 to FUtilList.Count-1 do begin
          sql := sql + ' ' + FUtilList.GetStringKey(i);
          if i <> FUtilList.Count-1 then
            sql := sql + ',';
        end;
        sql := sql + ') VALUES(';
        for i := 0 to FUtilList.Count-1 do begin
          sql := sql + ' ' + FUtilList.GetItem(i);
          if i <> FUtilList.Count-1 then
            sql := sql + ',';
        end;
        sql := sql + ')';


        q := TSQLQuery.Create(nil);
        q.SQLConnection := TDataBase;

        FClientDataSet:=TClientDataSet.Create(nil);
        FDataSetProvider:=TDataSetProvider.Create(nil);
        FClientDataSet.SetProvider(FDataSetProvider);
        FDataSetProvider.DataSet:=q;
        q.SQL.Text := sql;
       try
          q.ExecSQL;
        except
          q.Free;
          q := TSQLQuery.Create(nil);
          q.SQLConnection := TDataBase;
          q.SQL.Text := sql;
          try
            q.ExecSQL;
          except
          end;
        end;

      Try
        q.close;
        q.SQLConnection := TDataBase;
        q.SQL.Text:='SELECT trim(GEN_ID('+ 'GEN_'+TTableName + 
'_ID' + ', 0)) as FIELD FROM RDB$DATABASE' ;
        try
          q.Open;
        except
           //Ajuste para Generator antigo
          q.SQL.Text:='SELECT Trim(GEN_ID('+
 'GEN_'+TTableName+ ', 0)) AS FIELD FROM RDB$DATABASE' ;
          q.Open;
        end;
     //       end
     //   else if FormPrincipal.TypeConnection='SS' then begin
     //       q.SQL.Text:='Select IDENT_CURRENT('''+TTableName+''')  AS Field';
     //       q.Open;
    //    end;
        Result := q.FieldByName('FIELD').AsInteger;
        q.Close;
        q.Free;
      FClientDataSet.free;
      FDataSetProvider.free;
      except
      end;


end;

end.

Classe Lista Sobre essa classe você pode estudar neste artigo

Muito bem, uma vez implementadas as classes, crie um projeto teste com essa aparência.

Layout do Formulário

Figura 1. Layout do Formulário

Listagem: E faça as seguintes declarações:


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DB, ClassSQL;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button3: TButton;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Edit1: TEdit;
    Label1: TLabel;
  private
    { Private declarations }
    QSql:TClassSQL;
  public
    { Public declarations }

    procedure OpenSelect;
    procedure Save;
    procedure Delete;
  end;

Implemente os métodos:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DB, ClassSQL, FMTBcd, SqlExpr,
  Provider, DBClient;

type
  TForm1 = class(TForm)
    BtnInserir: TButton;
    BtnExcluir: TButton;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Edit1: TEdit;
    Label1: TLabel;
    BtnOpen: TButton;
    DataSetProvider1: TDataSetProvider;
    SQLQuery1: TSQLQuery;
    ClientDataSet1: TClientDataSet;
    BtnAlterar: TButton;
    procedure BtnOpenClick(Sender: TObject);
    procedure BtnInserirClick(Sender: TObject);
    procedure BtnAlterarClick(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure BtnExcluirClick(Sender: TObject);
  private
    { Private declarations }
    QSql:TClassSQL;
  public
    { Public declarations }
    procedure Create;
    procedure OpenSelect;
    procedure SaveInsert;
    procedure SaveUpDate;
    procedure Delete;
    procedure GetData;
  end;

var
  Form1: TForm1;

implementation

uses DataBase;

{$R *.dfm}

{ TForm1 }

procedure TForm1.Delete;
begin
  QSql:=TClassSQL.CreateSQL('Reg_CodeColor', 
Qsql.GetId('IdColor'), 'IdColor', Base.Base_);
  Qsql.ExecuteDelete;
//IRA EXLUIR O DADOS SELECIONADO NO GRID
end;

procedure TForm1.OpenSelect;
begin
{  Estacie a classe informando a tabela de conexao, 
o Id de pesquisa na tabela(caso necessario), o Field Id e a base de coenxao}
  Qsql.OpenTableSimple;
  DataSource1.DataSet:=QSql.GetQry;

end;

procedure TForm1.SaveInsert;
begin
   QSql.AddStringField('CodeColor',Edit1.Text);
   if Qsql.GetIsNotEmpty then
     QSql.ExecuteInsert ;

//   QSql.AddIntegerField('CodeColor',Edit1.Text);//Tipo Integer
//   QSql.AddDateField('CodeColor',Edit1.Text);//Tipo Date
//   QSql.AddTimeField('CodeColor',Edit1.Text);//Tipo Time
//   QSql.AddDoubleField('CodeColor',Edit1.Text)//TipoDouble
//      QSql.AddBooleanField('CodeColor',Edit1.Text);//Tipo Boolean

end;

procedure TForm1.BtnOpenClick(Sender: TObject);
begin
  Create;
  OpenSelect;
end;

procedure TForm1.Create;
begin
  QSql:=TClassSQL.CreateSQL('Reg_CodeColor', 0, 'IdColor', Base.Base_);
end;

procedure TForm1.BtnInserirClick(Sender: TObject);
begin
  SaveInsert;
  OpenSelect;
end;

procedure TForm1.SaveUpDate;
begin
   QSql.AddStringField('CodeColor',Edit1.Text);
   if Qsql.GetIsNotEmpty then
     QSql.ExecuteUpdate ;

//   QSql.AddIntegerField('CodeColor',Edit1.Text);//Tipo Integer
//   QSql.AddDateField('CodeColor',Edit1.Text);//Tipo Date
//   QSql.AddTimeField('CodeColor',Edit1.Text);//Tipo Time
//   QSql.AddDoubleField('CodeColor',Edit1.Text)//TipoDouble
//      QSql.AddBooleanField('CodeColor',Edit1.Text);//Tipo Boolean

end;

procedure TForm1.BtnAlterarClick(Sender: TObject);
begin
  SaveUpDate;
  OpenSelect;
end;

procedure TForm1.GetData;
begin
  Edit1.Text:=QSql.ListTableReturnField('CodeColor');
end;

procedure TForm1.DBGrid1CellClick(Column: TColumn);
begin
  GetData;
end;

procedure TForm1.BtnExcluirClick(Sender: TObject);
begin
  Delete;
  OpenSelect;
end;

end.

Pronto, agora devidamente linkado com seu banco de dados local é só testar!!!

Neste caso você não precisa mais encher a tela ou data modulo com dezenas de componentes de conexão PALETAS [interbase ou dbExpress], basta usar a Classe ClassSql, com isso talvez sem alguém perceber nos tivemos uma pequena introdução a PARADIGMA ORIENTADOA A OBJETOS.

Lembrando estude bem o conceito de Classes, analise as classes criadas para que possas entender o funcionamento delas.

Em uma próximo artigo com essas mesmas classes iremos criar componentes e frames para serem utilizados por este FrameWork.

Qualquer dúvida, comentário ou sugestão entre em contato atestanieski@gmail.com ou comercial@sinaiinformatica.com.br.

Alexandre Telles Estanieski

Alexandre Telles Estanieski - Tecnólogo em processamento de dados, cursando Ciências da Computação pela UniLasalle, diretor técnico e comercial da Sinai Informática Ltda, empresa de Porto Alegre, especializada em Assessoria em Informática com foco em desenvolvimento de sistemas, desenvolve em Delphi à 10 anos, tendo ampla experiência em técnicas de criação de componentes e POO.