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 EstanieskiSaudaçõ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:

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.

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.






