¡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.
Código Delphi
[-]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;
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
LSavedBuffers := TSavedBuffers.Create (Buffer, SettingBuffer);
Try
LNewValue := NativeValue (Field, Buffer); LPrevValue := Field.Value; Finally
LSavedBuffers.Restore;
End;
If LNewValue <> LPrevValue Then 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;
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
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;
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.