Ver Mensaje Individual
  #11  
Antiguo 21-11-2017
Avatar de Al González
[Al González] Al González is offline
In .pas since 1991
 
Registrado: May 2003
Posts: 5.502
Reputación: 22
Al González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en bruto
Pruebas exitosas

¡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.
__________________
Twitter
Código
Blog
WhatsApp para consultas rápidas y asesorías profesionales: +52 1 2711260117

Última edición por Al González fecha: 11-02-2018 a las 10:30:04. Razón: Mejora, y corrección de bug reportado en febrero de 2018.
Responder Con Cita