por ·0 comentários

Quando se trata de eventos o mais comum é encontrar uma propriedade que recebe um ponteiro para um procedimento.

Um tipo de evento comum é

property OnClick:TNotifyEvent ….

Para atribuir o evento ao objeto é preciso construir um procedimento para a classe e associá-lo ao evento do objeto, se você já tentou atribuir um procedimento que não esta ligado a uma classe, já notou que há limitações.

Porque criar um novo procedimento em uma classe que será utilizado em um objeto específico… Com eventos anônimos não precisa. (fontes)

[code lang=”pascal”]
TMinhaClasse = class(TObjectExt)
end;
…..

var FObjMinhaClasse:TMinhaClass;
begin
// definindo o evento anônimo
FObjMinhaClasse:= TMinhaClasse.create;
FObjMinhaClasse.onFireEvent := procedure (sender:TObject)
begin
……
end;
end;
…

// usando o evento anônimo
FObjMinhaClasse.FireEvent(sender);

[/code]

 

Recriando TObject

[code lang=”pascal”]

TObject = class(System.TObject)
private
FOnFireEvent: TProc<TObject>;
procedure SetOnFireEvent(const Value: TProc<TObject>);
public
procedure FireEvent;overload;
procedure FireEvent(Sender:TObject);overload;
property OnFireEvent:TProc<TObject> read FOnFireEvent write SetOnFireEvent;
end;

…..
{ TObject }

procedure TObject.FireEvent;
begin
FireEvent(self);
end;

procedure TObject.FireEvent(Sender: TObject);
begin
if assigned(FOnFireEvent) then
FonFireEvent(Sender);
end;

procedure TObject.SetOnFireEvent(const Value: TProc<TObject>);
begin
FOnFireEvent := Value;
end;
[/code]

 

Exemplos

Este post foi inspirado no livro do Nick Hodges “Coding in Delphi”

 

por ·0 comentários

Clone de ObjectDataset-JEDI para FireDAC….

Encontra-se no GIT o código para carregar um TObject ou TClass diretamente em um Dataset.
A implementação faz uso de RTTI para ler as propriedades do objeto e mapeia os tipo para as colunas do TFDMemTable do FireDAC.

Exemplo de uso:

[code lang=”pascal”]

// Exemplo de uma classe para mapear no Dataset
TMinhaClasse = class
private
….
published
property Nome: string read FNome write SetNome;
property id: integer read Fid write Setid;
property valor: double read Fvalor write Setvalor;
property Data: TDatetime read Fdata write Setdata;
property Dinheiro: Currency read FDinheiro write SetDinheiro;
property Cliente: double read FCliente write SetCliente;
end;

…..
uses FireDac.ObjectDataSet;
…..
// iniciando o Dataset com o link da Classe…
var ods:TObjectDataset;
begin
ods := TObjectDataset.Create(self, TMinhaClasse);
//DataSource1.DataSet := ods; // associa o Dataset a um Datasource
ods.Open;
end;

[/code]

Código Fontes no GIT

Lidando com uma lista externa

A classe mantem uma lista interna com os objetos publicando pela propriedade  TObjectDataset.ObjectList,  se você já possui uma lista externa pode utilizar os métodos:

procedure LoadFromList( AList:TList );   // carrega a lista externa para o TDataset
procedure SaveToList( AList:TList );        //  preeche a lista externa com os dados do TDataset;

Emprestando o exemplo do amigo (Marlon)

[code lang=”pascal”]
TCliente;
var
cli : TCliente;
ods : TObjectDataSet;
begin
cli := TCliente.Create;
cli.ID := 1;
cli.Nome := ”Marlon;
cli.Salario := 123.45;
cli.Dt_Nasc := Date;
ods := TObjectDataSet.Create(Self, TCliente);
ods.Open;
DataSource1.DataSet := ods;

// pode acrescentar o registro no Dataset;
ods.append;
ods.ObjectToField(cli); // não precisa fazer free… a lista interna faz a liberação de memoria.
ods.post;

// outra opção seria:
ods.append;
ods.FieldByname(‘id’).asInteger := 1;
ods.FieldByName(‘nome’).asString := ‘Marlon’;
…
ods.post;

[/code]

 

Contribuição do  Marlon

[code lang=”pascal”]

unit Unit56;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, FireDac.ObjectDataSet,
FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, Vcl.Mask, Vcl.DBCtrls,
Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Grids, Vcl.DBGrids;

type

TCliente = class
private
FDt_Nasc: TDate;
FSalario: Currency;
FID: Integer;
FNome: String;
procedure SetDt_Nasc(const Value: TDate);
procedure SetID(const Value: Integer);
procedure SetNome(const Value: String);
procedure SetSalario(const Value: Currency);
public
property ID : Integer read FID write SetID;
property Nome : String read FNome write SetNome;
property Salario : Currency read FSalario write SetSalario;
property Dt_Nasc : TDate read FDt_Nasc write SetDt_Nasc;
end;

TForm56 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Button1: TButton;
DBEdit1: TDBEdit;
DBEdit2: TDBEdit;
DBEdit3: TDBEdit;
DBEdit4: TDBEdit;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
ods : TObjectDataSet;
{ Private declarations }
public
{ Public declarations }
end;

var
Form56: TForm56;

implementation

{$R *.dfm}

{ TCliente }

procedure TCliente.SetDt_Nasc(const Value: TDate);
begin
FDt_Nasc := Value;
end;

procedure TCliente.SetID(const Value: Integer);
begin
FID := Value;
end;

procedure TCliente.SetNome(const Value: String);
begin
FNome := Value;
end;

procedure TCliente.SetSalario(const Value: Currency);
begin
FSalario := Value;
end;

procedure TForm56.Button1Click(Sender: TObject);
var
cli : TCliente;
begin
cli := TCliente.Create;

ods.FieldToObject(cli);

Edit1.Text := IntToStr(cli.ID);
Edit2.Text := cli.Nome;
Edit3.Text := CurrToStr(cli.Salario);
Edit4.Text := DateToStr(cli.Dt_Nasc);

end;

procedure TForm56.Button2Click(Sender: TObject);
var
cli : TCliente;
begin
cli := TCliente.Create;

cli.ID := StrToIntDef(Edit1.Text, 0);
cli.Nome := Edit2.Text;
cli.Salario := StrToCurrDef(Edit3.Text,0);
cli.Dt_Nasc := StrToDateDef(Edit4.Text, Date);

ods.Insert;
ods.ObjectToField(cli);
ods.Post;

end;

procedure TForm56.FormCreate(Sender: TObject);
begin
ods := TObjectDataSet.Create(Self, TCliente);
ods.Open;
DataSource1.DataSet := ods;
end;

end.

[/code]