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 Buscar Temas de Hoy Marcar Foros Como Leídos

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.498
Poder: 22
Al 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.
__________________
Twitter
Código
Blog
WhatsApp para consultas rápidas y asesorías profesionales: +52 1 2711260117
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 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
  #5  
Antiguo 06-11-2017
andrecrp77 andrecrp77 is offline
Registrado
 
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
  #6  
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.498
Poder: 22
Al 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...
__________________
Twitter
Código
Blog
WhatsApp para consultas rápidas y asesorías profesionales: +52 1 2711260117
Responder Con Cita
  #7  
Antiguo Hace 4 Semanas
andrecrp77 andrecrp77 is offline
Registrado
 
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: Hace 4 Semanas a las 11:57:27. Razón: code delphi
Responder Con Cita
  #8  
Antiguo Hace 4 Semanas
Avatar de Al González
[Al González] Al González is offline
In .pas since 1991
 
Registrado: may 2003
Posts: 5.498
Poder: 22
Al 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. :-)
__________________
Twitter
Código
Blog
WhatsApp para consultas rápidas y asesorías profesionales: +52 1 2711260117
Responder Con Cita
  #9  
Antiguo Hace 3 Semanas
Avatar de Al González
[Al González] Al González is offline
In .pas since 1991
 
Registrado: may 2003
Posts: 5.498
Poder: 22
Al 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.
__________________
Twitter
Código
Blog
WhatsApp para consultas rápidas y asesorías profesionales: +52 1 2711260117
Responder Con Cita
  #10  
Antiguo Hace 3 Semanas
Avatar de Al González
[Al González] Al González is offline
In .pas since 1991
 
Registrado: may 2003
Posts: 5.498
Poder: 22
Al 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.
__________________
Twitter
Código
Blog
WhatsApp para consultas rápidas y asesorías profesionales: +52 1 2711260117
Responder Con Cita
  #11  
Antiguo Hace 3 Semanas
Avatar de Al González
[Al González] Al González is offline
In .pas since 1991
 
Registrado: may 2003
Posts: 5.498
Poder: 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
      TempFieldData :PValueBuffer;
      Function NativeValue (Const AField :TField; ABuffer :TValueBuffer)
        :Variant;
      Procedure SetFieldData (Field :TField; Buffer :TValueBuffer);
        Override;
    Public
      Function GetFieldData (Field :TField; Var Buffer :TValueBuffer)
        :Boolean; 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;
Var
  LBuffer :TValueBuffer;
Begin
  { We copy ABuffer, that is, AField.FIOBuffer/FValueBuffer, because
    reading AField.Value changes AField.FIOBuffer/FValueBuffer. NOTE: Size
    of these buffers is constant (TDataSet.FIOBufferSize). }
  LBuffer := System.Copy (ABuffer);

  TempFieldData := @LBuffer;

  Try
    Result := AField.Value;
  Finally
    TempFieldData := Nil;

    // We restore AField.FIOBuffer/FValueBuffer
    System.Move (LBuffer [0], ABuffer [0], System.Length (LBuffer));
  End;
End;

Procedure TClientDataSetEx.SetFieldData (Field :TField;
  Buffer :TValueBuffer);
Var
  LBuffer :TValueBuffer;
  LNewValue, LPrevValue :Variant;
Begin
  If State In [dsEdit, dsInsert] Then
  Begin
    LNewValue := NativeValue (Field, Buffer);  // New value

    { We copy Buffer, that is, Field.FIOBuffer/FValueBuffer, because
      reading Field.Value changes Field.FIOBuffer/FValueBuffer. NOTE: Size
      of these buffers is constant (TDataSet.FIOBufferSize). }
    LBuffer := System.Copy (Buffer);

    Try
      LPrevValue := Field.Value;  // Previous value
    Finally
      // We restore Field.FIOBuffer/FValueBuffer
      System.Move (LBuffer [0], Buffer [0], System.Length (LBuffer));
    End;

    If LNewValue <> LPrevValue Then  // Is this a true modification?
    Begin
      If Assigned (BeforeFieldChange) Then
      Begin
        BeforeFieldChange (Field, LNewValue);

        { We restore Field.FIOBuffer/FValueBuffer if BeforeFieldChange read
          Field.Value, in order to the OnValidate event work properly. }
        System.Move (LBuffer [0], Buffer [0], System.Length (LBuffer));
      End;

      Inherited SetFieldData (Field, LBuffer);

      If Assigned (AfterFieldChange) Then
        AfterFieldChange (Field, LPrevValue);

      System.Exit;
    End;
  End;

  Inherited SetFieldData (Field, Buffer);
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.
__________________
Twitter
Código
Blog
WhatsApp para consultas rápidas y asesorías profesionales: +52 1 2711260117

Última edición por Al González fecha: Hace 3 Semanas a las 06:17:27.
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

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 00:26:45.


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