Problema con (Before/After)FieldChange

andrecrp77 · #1 06-11-2017

Cita:

Empezado por Al González

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

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?

Código Delphi [-]  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;

Código Delphi [-]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] · #2 20-11-2017

Cita:

Empezado por sirmenon

Sin embargo, no funcionó con Delphi Berlin.

Cita:

Empezado por andrecrp77

[...] 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] · #3 21-11-2017

¡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;

{ 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] · #4 22-09-2018

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. :-)