Problema con (Before/After)FieldChange

[sirmenon]

De acuerdo con os posts de Al Gonzalez em su blog RescatandoDelphi,
Implemente los eventos BeforeFieldChange y AfterFieldChange en Delphi 2010 utilizando la query de UNIDAC como herencia y obtuve éxito.

Sin embargo, no funcionó con Delphi Berlin.
He intentado debugar y me di cuenta de que la función NativeValue no devuelve los valores correctos.

¿Alguien sabría decirme cuál sería la solución?

Sigue el código del componente que he creado heredando de UNIDAC Query:
( perdón pero parece que no tengo permiso para insertar enlaces ni syntaxhilight en el foro )


unit MxUniQuery;

interface

uses
SysUtils, Classes, DB, MemDS, DBAccess, Uni;

type
{ Tipos de datos procedimentales para los eventos AfterFieldChange y BeforeFieldChange }
TFieldAfterChangeEvent = Procedure (Field :TField; PrevValue :Variant) Of Object;
TFieldBeforeChangeEvent = Procedure (Field :TField; NewValue :Variant) Of Object;

// Clase derivada de TUniQuery
TMxUniQuery = class(TUniQuery)
private
{ Private declarations }
FAfterFieldChange :TFieldAfterChangeEvent;
FBeforeFieldChange :TFieldBeforeChangeEvent;
protected
{ Protected declarations }
TempFieldData :PPointer;
Procedure SetFieldData (Field :TField; Buffer :Pointer); Override;
Function NativeValue (Const Field :TField; Const Buffer :Pointer) :Variant;
public
{ Public declarations }
Function GetFieldData (Field :TField; Buffer :Pointer) :Boolean; Override;
published
{ Published declarations }
Property AfterFieldChange:TFieldAfterChangeEvent Read FAfterFieldChange Write FAfterFieldChange;
Property BeforeFieldChange:TFieldBeforeChangeEvent Read FBeforeFieldChange Write FBeforeFieldChange;
end;


procedure Register;


implementation



procedure Register;
begin
RegisterComponents('MxDatabase', [TMxUniQuery]);
end;


{ TMxUniQuery }


Type
TFieldAccess = Class (TField);

function TMxUniQuery.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
begin
If TempFieldData = Nil Then
Result := Inherited GetFieldData (Field,Buffer)
Else
Begin
Result := TempFieldData^ <> Nil;

If Result And (Buffer <> Nil) Then
TFieldAccess (Field).CopyData (TempFieldData^, Buffer);
End;
end;


function TMxUniQuery.NativeValue(const Field: TField;
const Buffer: Pointer): Variant;
begin
TempFieldData := @Buffer;

Try
Result := Field.Value;
Finally
TempFieldData := Nil;
End;
end;


procedure TMxUniQuery.SetFieldData(Field: TField; Buffer: Pointer);
var
Value: Variant;
begin
// inherited;

If State In [dsEdit, dsInsert] Then
Begin
// NewValue
Value := NativeValue (Field, Buffer);

If Value <> Field.Value Then // Sí cambia
Begin
If Assigned (BeforeFieldChange) Then
BeforeFieldChange (Field, Value);

Value := Field.Value; // PrevValue
Inherited SetFieldData (Field, Buffer);

If Assigned (AfterFieldChange) Then
AfterFieldChange (Field, Value);

Exit;
End;
End;

Inherited SetFieldData (Field, Buffer);

end;

end.

[Al González]

¡Órale! Alguien se interesa en el código de mi antiguo blog. :eek:

Afortunadamente hoy también yo uso Delphi Berlin. Veré si puedo encontrar un espacio para revisar lo que comentas. Dos preguntas:

¿Te refieres a FireDAC? (Creo que antes se llamaba UNIDAC).

¿Podrías explicar con el mayor detalle posible lo que estás obteniendo?

Muchas gracias.

[sirmenon]

Hola Al Gonzalez,

Firedac (antiguo AnyDac) es diferente de Devart Unidac.

El código probado es muy simple lo que tengo es esto:

TdmVendas.qryClienteNewRecord (DataSet: TDataSet);
Inicio
qryClienteCODIGO_CLI.Value: = GetAutoInc ('CLIENTE');
end;

Este código sirve para hacer auto-incremento en un campo del tipo Integer.
GetAutoInc ('CLIENTE') devuelve el valor correcto pero el valor establecido en el campo siempre es 0.

Debugando el código (sin profundizar mucho por falta de conocimiento), percibí que en la función NativeValue del componente en la línea "Result: = Field.Value;" siempre devuelve 0.

[sirmenon]

¿Alguien más llegó a identificar este problema?

Hasta hoy esta fue la forma más inteligente y rápida que encontré para trabajar con la validación de campos y campos calculados (sin tener que hacer uso muy extenso de OOP).

[andrecrp77]

¡Órale! Alguien se interesa en el código de mi antiguo blog. :eek:

Afortunadamente hoy también yo uso Delphi Berlin. Veré si puedo encontrar un espacio para revisar lo que comentas. Dos preguntas:

¿Te refieres a FireDAC? (Creo que antes se llamaba UNIDAC).

¿Podrías explicar con el mayor detalle posible lo que estás obteniendo?

Muchas gracias.



Hola Al González

Implemente el componente TSysClientDataSet con los eventos BeforeFieldChange / AfterFieldChange en Delphi 7/2006 según sus ejemplos de 2010 y realmente han sido de gran utilidad hasta hoy, sin embargo, estoy migrando todos los componentes a Delphi Berlin / Tokyo, el problema está en los Pointer que pasaron a TValueBuffer en el Berlin / Tokyo.
¿Tiene alguna idea de lo que puede estar equivocado?

protected
//TempFieldData:TValueBuffer;
TempFieldData:PPointer;
function NativeValue(const Field :TField; const Buffer:TValueBuffer):Variant;
procedure SetFieldData(Field: TField; Buffer: TValueBuffer);override;
public
function GetFieldData(Field: TField; var Buffer: TValueBuffer):Boolean;override;


function TSysClientDataSet.GetFieldData (Field :TField; var Buffer :TValueBuffer) :Boolean;
begin
if TempFieldData = nil then
Result := Inherited GetFieldData (Field,Buffer)
else
begin
Result := TempFieldData^ <> Nil;
if Result and (Buffer <> Nil) Then
Move(TempFieldData^, Buffer[0], Field.Size);
//TFieldAccess(Field).CopyData(TempFieldData, Buffer);
end;
end;

function TSysClientDataSet.NativeValue (Const Field :TField; Const Buffer :TValueBuffer):Variant;
begin
TempFieldData := @Buffer[0];
try
Result := Field.Value;
finally
TempFieldData := Nil;
end;
end;

procedure TSysClientDataSet.SetFieldData(Field: TField; Buffer: TValueBuffer);
var
Value :Variant;
begin
if State in [dsEdit, dsInsert] then
begin
// NewValue
Value := NativeValue (Field, Buffer);
if Value <> Field.Value Then // Sí cambia
begin
if Assigned (BeforeFieldChange) Then
BeforeFieldChange (Field, Value);
Value := Field.Value; // PrevValue
inherited SetFieldData (Field, Buffer);
if Assigned (AfterFieldChange) then
AfterFieldChange (Field, Value);
exit;
end;
end;
inherited SetFieldData (Field, Buffer);
end;



Muchas gracias

[Al González]

¿Alguien más llegó a identificar este problema?

Hasta hoy esta fue la forma más inteligente y rápida que encontré para trabajar con la validación de campos y campos calculados (sin tener que hacer uso muy extenso de OOP).
Muchas gracias. Es motivante leer lo último. Intentaré encontrar la forma de dedicar tiempo y recursos a esa solución para Delphi Berlin/Tokyo. Ya veo que son varios los colegas que se encontrarán con la misma situación debido a los cambios que han tenido las clases nativas...

[andrecrp77]

Hola.

Sigue la solución que encontré para continuar utilizando los eventos Before / Afterfieldchange en Delphi Tokyo.
Estamos en el camino correcto, algún ajuste?

unit utilclientdataset;

Interface

uses

DB, DBClient;

type

TFieldAfterChangeEvent = procedure (Field :TField; PrevValue :Variant) Of Object;
TFieldBeforeChangeEvent = procedure (Field :TField; NewValue :Variant) Of Object;

TSysClientDataSet = Class (TClientDataSet)
private
FAfterFieldChange :TFieldAfterChangeEvent;
FBeforeFieldChange :TFieldBeforeChangeEvent;
protected
TempFieldData:TValueBuffer;
procedure NativeValue(Const Field :TField; ABuffer :TValueBuffer; var ANewValue:Variant; var ANewValueBuffer :TValueBuffer);
procedure SetFieldData(Field :TField; Buffer :TValueBuffer);override;
public
function GetFieldData(Field: TField; var Buffer: TValueBuffer): Boolean;override;
published
property AfterFieldChange :TFieldAfterChangeEvent Read FAfterFieldChange Write FAfterFieldChange;
property BeforeFieldChange :TFieldBeforeChangeEvent Read FBeforeFieldChange Write FBeforeFieldChange;
end;

implementation

type
TFieldAccess = Class (TField);

function TSysClientDataSet.GetFieldData(Field: TField; var Buffer: TValueBuffer): Boolean;
begin
if TempFieldData=nil then
Result:=Inherited GetFieldData(Field,Buffer)
else
begin
Result:=TempFieldData <> Nil;
if Result and (Buffer <> Nil) then
TPlatformValueBuffer.Copy(TempFieldData,0,Buffer,Field.DataSize);
end;
end;

procedure TSysClientDataSet.NativeValue(Const Field :TField; ABuffer :TValueBuffer; var ANewValue:Variant; var ANewValueBuffer :TValueBuffer);
begin
TempFieldData := TPlatformValueBuffer.CreateValueBuffer(Field.DataSize);
try
TPlatformValueBuffer.Copy(ABuffer,0,TempFieldData,Field.DataSize);
TPlatformValueBuffer.Copy(ABuffer,0,ANewValueBuffer,Field.DataSize);
ANewValue:=Field.Value;
finally
TempFieldData:=Nil;
end;
end;

procedure TSysClientDataSet.SetFieldData(Field :TField; Buffer :TValueBuffer);
var
NewValue, PrevValue:Variant;
NewValueBuffer:TValueBuffer;
begin
if State in [dsEdit, dsInsert] then
begin
NewValueBuffer:= TPlatformValueBuffer.CreateValueBuffer(Field.DataSize);
try
NativeValue (Field, Buffer, NewValue, NewValueBuffer);
if NewValue <> Field.Value then
begin
if Assigned (BeforeFieldChange) Then
BeforeFieldChange (Field, NewValue);
PrevValue := Field.Value;
inherited SetFieldData (Field, NewValueBuffer);
if Assigned (AfterFieldChange) then
AfterFieldChange (Field, PrevValue);
Exit;
end;
finally
NewValueBuffer:=nil;
end;
end;
inherited SetFieldData (Field, Buffer);
end;

end.

[Al González]

¡Gracias! Echaré un vistazo y haré pruebas de tus modificaciones. Más tarde comentaré lo que encuentre. :-)

[Al González]

Me congratulo de haber conseguido patrocinio para realizar la adaptación que aquí se pide. Para los que no estén muy enterados del tema, les dejo este material (http://rescatandoadelphi.blogspot.mx/2010/02/eventos-beforefieldchange-y.html).

Lo colgaré como una solución open source cuando estén hechas las pruebas.

[Al González]

Sin embargo, no funcionó con Delphi Berlin.
[...] migrando todos los componentes a Delphi Berlin / Tokyo, el problema está en los Pointer que pasaron a TValueBuffer en el Berlin / Tokyo.
En efecto, ya estoy viendo la causa. Los métodos virtuales que redefine la implementación original están ahora en desuso (deprecated). En su lugar, debo redefinir ahora los que emplean el tipo de dato TValueBuffer (que no es más que un vector de bytes). En un rato más tendré algún avance sobre esto.

Saludos. :)

[Al González]

¡Hola!

Contento porque he terminado de hacer los cambios necesarios para adaptar esta implementación de los eventos BeforeFieldChange y AfterFieldChange a las más recientes versiones de Delphi. Les dejo aquí el código de la clase que usé para las pruebas. Recuerden que, en teoría, puede aplicar también a cualquier otra clase de data set.
Unit UClientDataSetEx;

Interface

Uses
Data.DB, DataSnap.DBClient;

Type
PValueBuffer = ^TValueBuffer;

TAfterFieldChangeEvent = Procedure (AField :TField; APrevValue :Variant)
Of Object;

TBeforeFieldChangeEvent = Procedure (AField :TField; ANewValue :Variant)
Of Object;

TClientDataSetEx = Class (TClientDataSet)
Private
FAfterFieldChange :TAfterFieldChangeEvent;
FBeforeFieldChange :TBeforeFieldChangeEvent;
Protected
Type
TSavedBuffers = Record
Ptrs, Data :Array [0..1] Of TValueBuffer;
Constructor Create (Const A1, A2 :TValueBuffer);
Procedure Restore;
End;

Var
SettingBuffer :TValueBuffer;
TempFieldData :PValueBuffer;

Function NativeValue (Const AField :TField; ABuffer :TValueBuffer)
:Variant;
Procedure SetFieldData (Field :TField; Buffer :TValueBuffer;
NativeFormat :Boolean); Overload; Override;
Procedure SetFieldData (Field :TField; Buffer :TValueBuffer);
Overload; Override;
Public
Function GetFieldData (Field :TField; Var Buffer :TValueBuffer)
:Boolean; Overload; Override;
Published
Property AfterFieldChange :TAfterFieldChangeEvent
Read FAfterFieldChange Write FAfterFieldChange;
Property BeforeFieldChange :TBeforeFieldChangeEvent
Read FBeforeFieldChange Write FBeforeFieldChange;
End;

Procedure Register;

Implementation

Uses
System.Classes;

{ TClientDataSetEx }

Type
TFieldAccess = Class (TField);
Function TClientDataSetEx.GetFieldData (Field :TField;
Var Buffer :TValueBuffer) :Boolean;
Begin
If TempFieldData = Nil Then
Result := Inherited GetFieldData (Field, Buffer)
Else
Begin
Result := TempFieldData^ <> Nil;

If Result And (Buffer <> Nil) Then
TFieldAccess (Field).CopyData (TempFieldData^, Buffer);
End;
End;

Function TClientDataSetEx.NativeValue (Const AField :TField;
ABuffer :TValueBuffer) :Variant;
Begin
ABuffer := System.Copy (ABuffer);
TempFieldData := @ABuffer;

Try
Result := AField.Value;
Finally
TempFieldData := Nil;
End;
End;

Procedure TClientDataSetEx.SetFieldData (
Field :TField; Buffer :TValueBuffer; NativeFormat :Boolean);
Begin
If State In [dsEdit, dsInsert] Then
SettingBuffer := Buffer;

Inherited SetFieldData (Field, Buffer, NativeFormat);
End;

Procedure TClientDataSetEx.SetFieldData (Field :TField;
Buffer :TValueBuffer);
Var
LNewValue, LPrevValue :Variant;
LSavedBuffers :TSavedBuffers;
Begin
If State In [dsEdit, dsInsert] Then
Begin
{ We save Field.FIOBuffer/Field.FValueBuffer/FIOTempBuffer, because
reading Field.Value changes those buffers. }
LSavedBuffers := TSavedBuffers.Create (Buffer, SettingBuffer);

Try
LNewValue := NativeValue (Field, Buffer); // New value
LPrevValue := Field.Value; // Previous value
Finally
LSavedBuffers.Restore;
End;

If LNewValue <> LPrevValue Then // Is this a true modification?
Begin
If Assigned (BeforeFieldChange) Then
Try
BeforeFieldChange (Field, LNewValue);
Finally
LSavedBuffers.Restore;
End;

Inherited SetFieldData (Field, Buffer);

If Assigned (AfterFieldChange) Then
AfterFieldChange (Field, LPrevValue);

System.Exit;
End;
End;

Inherited SetFieldData (Field, Buffer);
End;

{ TClientDataSetEx.TSavedBuffer }

Constructor TClientDataSetEx.TSavedBuffers.Create (
Const A1, A2 :TValueBuffer);
Begin
Ptrs [0] := A1;
Data [0] := System.Copy (A1);

If A2 <> A1 Then
Begin
Ptrs [1] := A2;
Data [1] := System.Copy (A2);
End
Else
Begin
Ptrs [1] := Nil;
Data [1] := Nil;
End;
End;

Procedure TClientDataSetEx.TSavedBuffers.Restore;
Begin
// NOTE: Size of these buffers is constant (TDataSet.FIOBufferSize).

System.Move (Data [0] [0], Ptrs [0] [0], System.Length (Data [0]));

If Ptrs [1] <> Nil Then
System.Move (Data [1] [0], Ptrs [1] [0], System.Length (Data [1]));
End;

{ Procedures and functions }

Procedure Register;
Begin
RegisterComponents ('Samples', [TClientDataSetEx]);
End;

End.

Les agradezco por las pruebas que ustedes hagan con sus componentes, para saber si la solución es 100% efectiva. Veo que hay un par de cosas que puedo mejorar, pero considero que de momento así puede servir bastante bien.

Un saludo. :)

Al González.

NOTA: Modifiqué el código para corregir cierto problema con el evento OnValidate. Probé OnChange, OnValidate, BeforeFieldChange y AfterFieldChange, funcionando todo correctamente. Pero agradezco la confirmación que ustedes puedan hacer probando con otros componentes de base de datos. El código puede ser mejorado en varios aspectos, y probablemente intente optimizarlo luego.

[Al González]

Bueno, me llegó una notificación a mi correo sobre una retroalimentación de leus a este hilo.

Entiendo que puede tener poca relación. Aunque por los últimos mensajes que él ha publicado, podría al menos responderle que sí: que Embarcadero ha hecho sutiles cambios a la unidad Data.DB.pas, lo cual ha impactado en el funcionamiento de clases antiguas de datasets. Los cambios, para mi punto de vista son acertados, pero evidentemente que nos toca reacomodar algunas cosas en los componentes más viejos cuando vemos que algo ya no funciona igual. Fue el caso de sirmenon y andrecrp77, que felizmente pudieron (al menos el último) seguir usando la implementación de eventos BeforeFieldChange y AfterFieldChange, hecha originalmente para la manera en que trabajaba el TDataSet de Delphi 7, ahora disponible también para Berlin y similares.

En seguida voy al otro hilo a retroalimentar un poco también. :-)