Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Bibliotecas de código fuente > [GH Freebrary]
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 31-08-2017
sirmenon sirmenon is offline
Registrado
 
Registrado: abr 2010
Posts: 9
Poder: 0
sirmenon Va por buen camino
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.

Última edición por ecfisa fecha: 31-08-2017 a las 21:19:24. Razón: Agregar etiquetas [Delphi] [/Delphi]
Responder Con Cita
  #2  
Antiguo 31-08-2017
Avatar de Al González
[Al González] Al González is offline
In .pas since 1991
 
Registrado: may 2003
Posts: 5.609
Poder: 30
Al González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en bruto
¡Ó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.
Responder Con Cita
  #3  
Antiguo 01-09-2017
sirmenon sirmenon is offline
Registrado
 
Registrado: abr 2010
Posts: 9
Poder: 0
sirmenon Va por buen camino
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.
Responder Con Cita
  #4  
Antiguo 06-11-2017
andrecrp77 andrecrp77 is offline
Registrado
NULL
 
Registrado: nov 2017
Posts: 2
Poder: 0
andrecrp77 Va por buen camino
Question BeforeFieldChange / AfterFieldChange - Pointer vs TValueBuffer

Cita:
Empezado por Al González Ver Mensaje
¡Ó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

Última edición por andrecrp77 fecha: 06-11-2017 a las 02:20:57. Razón: Code Delphi
Responder Con Cita
  #5  
Antiguo 20-11-2017
Avatar de Al González
[Al González] Al González is offline
In .pas since 1991
 
Registrado: may 2003
Posts: 5.609
Poder: 30
Al González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en bruto
Cita:
Empezado por sirmenon Ver Mensaje
Sin embargo, no funcionó con Delphi Berlin.
Cita:
Empezado por andrecrp77 Ver Mensaje
[...] 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.
Responder Con Cita
  #6  
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.609
Poder: 30
Al González Es un diamante en brutoAl 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.

Última edición por Al González fecha: 11-02-2018 a las 11:30:04. Razón: Mejora, y corrección de bug reportado en febrero de 2018.
Responder Con Cita
  #7  
Antiguo 22-09-2018
Avatar de Al González
[Al González] Al González is offline
In .pas since 1991
 
Registrado: may 2003
Posts: 5.609
Poder: 30
Al González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en bruto
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. :-)
Responder Con Cita
  #8  
Antiguo 24-10-2017
sirmenon sirmenon is offline
Registrado
 
Registrado: abr 2010
Posts: 9
Poder: 0
sirmenon Va por buen camino
¿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).
Responder Con Cita
  #9  
Antiguo 10-11-2017
Avatar de Al González
[Al González] Al González is offline
In .pas since 1991
 
Registrado: may 2003
Posts: 5.609
Poder: 30
Al González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en bruto
Cita:
Empezado por sirmenon Ver Mensaje
¿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...
Responder Con Cita
  #10  
Antiguo 13-11-2017
andrecrp77 andrecrp77 is offline
Registrado
NULL
 
Registrado: nov 2017
Posts: 2
Poder: 0
andrecrp77 Va por buen camino
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.

Última edición por andrecrp77 fecha: 13-11-2017 a las 11:57:27. Razón: code delphi
Responder Con Cita
  #11  
Antiguo 13-11-2017
Avatar de Al González
[Al González] Al González is offline
In .pas since 1991
 
Registrado: may 2003
Posts: 5.609
Poder: 30
Al González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en bruto
¡Gracias! Echaré un vistazo y haré pruebas de tus modificaciones. Más tarde comentaré lo que encuentre. :-)
Responder Con Cita
  #12  
Antiguo 19-11-2017
Avatar de Al González
[Al González] Al González is offline
In .pas since 1991
 
Registrado: may 2003
Posts: 5.609
Poder: 30
Al González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en bruto
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.
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 01:14:00.


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
Copyright 1996-2007 Club Delphi