Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   [GH Freebrary] (https://www.clubdelphi.com/foros/forumdisplay.php?f=54)
-   -   Problema con (Before/After)FieldChange (https://www.clubdelphi.com/foros/showthread.php?t=92228)

sirmenon 31-08-2017 21:09:13

Problema con (Before/After)FieldChange
 
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 )

Código Delphi [-]
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 31-08-2017 23:37:45

¡Ó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 01-09-2017 13:34:58

Hola Al Gonzalez,

Firedac (antiguo AnyDac) es diferente de Devart Unidac.

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

Código Delphi [-]
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 24-10-2017 22:12:43

¿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 06-11-2017 01:59:04

BeforeFieldChange / AfterFieldChange - Pointer vs TValueBuffer
 
Cita:

Empezado por Al González (Mensaje 520749)
¡Ó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?

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 10-11-2017 21:32:18

Cita:

Empezado por sirmenon (Mensaje 521983)
¿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 13-11-2017 11:54:04

Solución ?
 
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?

Código Delphi [-]
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 13-11-2017 20:38:26

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

Al González 19-11-2017 01:39:49

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.

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

Al González 20-11-2017 19:41:55

Cita:

Empezado por sirmenon (Mensaje 520744)
Sin embargo, no funcionó con Delphi Berlin.

Cita:

Empezado por andrecrp77 (Mensaje 522266)
[...] 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 21-11-2017 06:02:34

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.

Al González 22-09-2018 19:12:34

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


La franja horaria es GMT +2. Ahora son las 12:34:58.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi